30 lines
1.1 KiB
Mathematica
30 lines
1.1 KiB
Mathematica
SPNLS2 ;ISC-SF/RAH - INDIVIDUAL FULL HISTORY FORCED RE-SEND ;9/25/95 11:10
|
|
V ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|
;
|
|
EN1 ; ID Registrant
|
|
S DIC(0)="AEMQZ",DIC="^SPNL(154,",DIC("A")="Select PATIENT: "
|
|
W ! D ^DIC G:$D(DTOUT)!($D(DUOUT))!(X="") END
|
|
S SPNLTMPY=Y,SPNLTMPX=X K DIC,X,Y
|
|
I SPNLTMPY=-1 W !!," COULD NOT FIND REGISTRANT: ",SPNLTMPX,". TRY AGAIN.",! G EN1
|
|
S SPNLPID=$P(SPNLTMPY,U,1)
|
|
S DIR(0)="YOA",DIR("A")="OK to Full History: ",DIR("B")="YES" D ^DIR K DIR
|
|
I Y'=1 G EN1
|
|
I "1^T"'=$P(^SPNL(154,SPNLPID,0),U,3,4) W !!," REGISTRANT NOT ELIGIBLE FOR TRANSMISSION. CHECK STATUSES",!! G EN1
|
|
S DIC(0)="MNO",DIC="^SPNL(154.9,",X=SPNLPID D ^DIC
|
|
I Y=-1 W !!," REGISTRANT FULL HISTORY WILL BE SENT AT NEXT SCHEDULED TRANSMISSION.",!! G EN1
|
|
K DIC,X,Y
|
|
SETDEFS ;
|
|
S (SPNLFDT,SPNLTDT)=1000101
|
|
IDPTX ;
|
|
S DA=SPNLPID,DIE="^SPNL(154.9,"
|
|
S DR="1///^S X=SPNLFDT;2///^S X=SPNLTDT"
|
|
D ^DIE K DIE,DA,DR
|
|
S DA=SPNLPID,DIE=154,DR="9///1" D ^DIE
|
|
K DIE,DA,DR
|
|
W !!," REGISTRANT FULL HISTORY WILL BE SENT AT NEXT SCHEDULED TRANSMISSION.",!!
|
|
G EN1
|
|
END ;
|
|
K DIC,X,Y
|
|
K SPNLPID,SPNLFDT,SPNLTDT,SPNLTMPX,SPNLTMPY
|
|
Q
|