39 lines
1.0 KiB
Mathematica
39 lines
1.0 KiB
Mathematica
|
SPNLPDM0 ;HISC/DAD-REGISTRY DUMP ;9/18/95 12:28
|
||
|
;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
||
|
;
|
||
|
K ^TMP($J,"SPNLPDM"),^TMP($J,"SPNLPDM0")
|
||
|
S SPNDIC="^SPNL(154,",SPNDIC(0)="AEMNQZ"
|
||
|
S SPNDIC("A")="Select PATIENT: ",SPNUTIL="SPNLPDM0"
|
||
|
D ^SPNUTL0 I SPNQUIT G EXIT
|
||
|
;
|
||
|
K %ZIS,IOP S %ZIS="QMN" W ! D ^%ZIS G:POP EXIT
|
||
|
S SPNLIOP=ION_";"_IOM
|
||
|
I $D(IO("Q")) D G EXIT
|
||
|
. S ZTRTN="TASK^SPNLPDM0"
|
||
|
. S ZTSAVE("SPNLIOP")=""
|
||
|
. S ZTSAVE("^TMP($J,""SPNLPDM0"",")=""
|
||
|
. S ZTDESC="SCD Registry Dump Report"
|
||
|
. D ^%ZTLOAD
|
||
|
. Q
|
||
|
TASK ;
|
||
|
S SPNLNAME=""
|
||
|
F S SPNLNAME=$O(^TMP($J,"SPNLPDM0",SPNLNAME)) Q:SPNLNAME="" D
|
||
|
. S SPNLD0=0
|
||
|
. F S SPNLD0=$O(^TMP($J,"SPNLPDM0",SPNLNAME,SPNLD0)) Q:SPNLD0'>0 D
|
||
|
.. S ^TMP($J,"SPNLPDM",SPNLD0)=""
|
||
|
.. Q
|
||
|
. Q
|
||
|
PRINT ;
|
||
|
S IOP=SPNLIOP
|
||
|
S DIC="^SPNL(154,"
|
||
|
S BY="#.01",BY(0)="^TMP($J,""SPNLPDM"","
|
||
|
S (FR,TO)=""
|
||
|
S L=0,L(0)=1
|
||
|
S FLDS="[SPNL REGISTRY DUMP]"
|
||
|
D EN1^DIP
|
||
|
EXIT ;
|
||
|
D ^%ZISC
|
||
|
K %ZIS,BY,DIC,FLDS,FR,IOP,L,POP,SPNDIC,SPNLD0,SPNLIOP,SPNLNAME,SPNQUIT
|
||
|
K SPNUTIL,TO,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"SPNLPDM"),^TMP($J,"SPNLPDM0")
|
||
|
Q
|