VistA-FOIAVistA/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLPDM0.m

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