- 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 Mar 13, 2025@20:46:16 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
