QAMAHO3.m

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 ***

HEADER W !!?5,"Enter the special report header, if desired (maximum 55 characters): "

 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 ---QAMAHO3   1640     printed  Apr 09, 2024@20:47:52                                                                                                                                                                                                     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 ***

HEADER     WRITE !!?5,"Enter the special report header, if desired (maximum 55 characters): "

 +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