QAMAHO3 ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;1/18/95 10:01
;;1.0;Clinical Monitoring System;**4**;09/13/1993
;
S Y=DT,PAGE=0 X ^DD("DD") S TODAY=Y,$P(BNDRY,"-",81)="",QAMFIN=""
;*** Choose header ***
R !?5,HEAD:DTIME I '$T!(HEAD["^") D KILL Q
I $L(HEAD)>55 W *7,!!?5,"Exceeds 55 characters!! " G HEADER
I $E(HEAD)="?" W !!?5,*7,"Enter the special report header. " G HEADER
S:HEAD="" HEAD="AD HOC FALL OUT REPORT" S HEAD(0)="SORTED BY "_SARRAY(1)_$S($D(SARRAY(2))#2:" & "_SARRAY(2),1:"")
;*** Choose device ***
K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS W !! G:POP KILL
I $D(IO("Q")) K IO("Q") S ZTRTN="STRT^QAMAHO3",ZTDESC="Generate Fall-Out reports." D QLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),! G EXIT
STRT U IO K QAM1,QAM2 S QAM1=SARRY(1) S:$D(SARRY(2)) QAM2=SARRY(2)
S LABEL1=$S(QAM1=1:"QAM PAT",QAM1=2:"QAM MON",QAM1=3:"QAM DATE",1:"QAM DLMNT")
S:$D(QAM2) LABEL2=$S(QAM2=1:"QAM PAT",QAM2=2:"QAM MON",QAM2=3:"QAM DATE",1:"QAM DLMNT")
D ^QAMAHO3A
EXIT W ! D ^%ZISC
KILL K %ZIS,BA,BNDRY,CD,CD1,DIWF,DIWL,DIWR,GC,HDER,HEAD,IEN,JD,JD1,LABEL1,LABEL2,LOOP,LP,LP1,MN,MN1,PAGE,PARRY,POP,QAM0,QAM1,QAM2,QAMFIN,QAMJD,QAMNDE,QAMTAB,QAMX,SARRY,SHD,SUB,SUB1,TAB,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
Q
QLOOP ;
F BA="^UTILITY($J,""QAM ELEMENT"",","^UTILITY($J,""QAM MON"",","^UTILITY($J,""QAM DLMNT"",","^UTILITY($J,""QAM DATE"",","^UTILITY($J,""QAM PAT""," S ZTSAVE(BA)=""
F BA="BNDRY","HEAD","HEAD(0)","PAGE","PARRY(","PARRAY(","QAMFIN","SARRY(","SARRAY(","TODAY" S ZTSAVE(BA)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAHO3 1640 printed Oct 16, 2024@17:42:28 Page 2
QAMAHO3 ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;1/18/95 10:01
+1 ;;1.0;Clinical Monitoring System;**4**;09/13/1993
+2 ;
+3 SET Y=DT
SET PAGE=0
XECUTE ^DD("DD")
SET TODAY=Y
SET $PIECE(BNDRY,"-",81)=""
SET QAMFIN=""
+4 ;*** Choose header ***
+1 READ !?5,HEAD:DTIME
IF '$TEST!(HEAD["^")
DO KILL
QUIT
+2 IF $LENGTH(HEAD)>55
WRITE *7,!!?5,"Exceeds 55 characters!! "
GOTO HEADER
+3 IF $EXTRACT(HEAD)="?"
WRITE !!?5,*7,"Enter the special report header. "
GOTO HEADER
+4 if HEAD=""
SET HEAD="AD HOC FALL OUT REPORT"
SET HEAD(0)="SORTED BY "_SARRAY(1)_$SELECT($DATA(SARRAY(2))#2:" & "_SARRAY(2),1:"")
+5 ;*** Choose device ***
+6 KILL %ZIS,IOP
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
WRITE !!
if POP
GOTO KILL
+7 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="STRT^QAMAHO3"
SET ZTDESC="Generate Fall-Out reports."
DO QLOOP
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!"),!
GOTO EXIT
STRT USE IO
KILL QAM1,QAM2
SET QAM1=SARRY(1)
if $DATA(SARRY(2))
SET QAM2=SARRY(2)
+1 SET LABEL1=$SELECT(QAM1=1:"QAM PAT",QAM1=2:"QAM MON",QAM1=3:"QAM DATE",1:"QAM DLMNT")
+2 if $DATA(QAM2)
SET LABEL2=$SELECT(QAM2=1:"QAM PAT",QAM2=2:"QAM MON",QAM2=3:"QAM DATE",1:"QAM DLMNT")
+3 DO ^QAMAHO3A
EXIT WRITE !
DO ^%ZISC
KILL KILL %ZIS,BA,BNDRY,CD,CD1,DIWF,DIWL,DIWR,GC,HDER,HEAD,IEN,JD,JD1,LABEL1,LABEL2,LOOP,LP,LP1,MN,MN1,PAGE,PARRY,POP,QAM0,QAM1,QAM2,QAMFIN,QAMJD,QAMNDE,QAMTAB,QAMX,SARRY,SHD,SUB,SUB1,TAB,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+1 QUIT
QLOOP ;
+1 FOR BA="^UTILITY($J,""QAM ELEMENT"",","^UTILITY($J,""QAM MON"",","^UTILITY($J,""QAM DLMNT"",","^UTILITY($J,""QAM DATE"",","^UTILITY($J,""QAM PAT"","
SET ZTSAVE(BA)=""
+2 FOR BA="BNDRY","HEAD","HEAD(0)","PAGE","PARRY(","PARRAY(","QAMFIN","SARRY(","SARRAY(","TODAY"
SET ZTSAVE(BA)=""
+3 QUIT
