1 | QAMAHO3 ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;1/18/95 10:01
|
---|
2 | ;;1.0;Clinical Monitoring System;**4**;09/13/1993
|
---|
3 | ;
|
---|
4 | S Y=DT,PAGE=0 X ^DD("DD") S TODAY=Y,$P(BNDRY,"-",81)="",QAMFIN=""
|
---|
5 | ;*** Choose header ***
|
---|
6 | HEADER W !!?5,"Enter the special report header, if desired (maximum 55 characters): "
|
---|
7 | R !?5,HEAD:DTIME I '$T!(HEAD["^") D KILL Q
|
---|
8 | I $L(HEAD)>55 W *7,!!?5,"Exceeds 55 characters!! " G HEADER
|
---|
9 | I $E(HEAD)="?" W !!?5,*7,"Enter the special report header. " G HEADER
|
---|
10 | S:HEAD="" HEAD="AD HOC FALL OUT REPORT" S HEAD(0)="SORTED BY "_SARRAY(1)_$S($D(SARRAY(2))#2:" & "_SARRAY(2),1:"")
|
---|
11 | ;*** Choose device ***
|
---|
12 | K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS W !! G:POP KILL
|
---|
13 | 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
|
---|
14 | STRT U IO K QAM1,QAM2 S QAM1=SARRY(1) S:$D(SARRY(2)) QAM2=SARRY(2)
|
---|
15 | S LABEL1=$S(QAM1=1:"QAM PAT",QAM1=2:"QAM MON",QAM1=3:"QAM DATE",1:"QAM DLMNT")
|
---|
16 | S:$D(QAM2) LABEL2=$S(QAM2=1:"QAM PAT",QAM2=2:"QAM MON",QAM2=3:"QAM DATE",1:"QAM DLMNT")
|
---|
17 | D ^QAMAHO3A
|
---|
18 | EXIT W ! D ^%ZISC
|
---|
19 | 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
|
---|
20 | Q
|
---|
21 | QLOOP ;
|
---|
22 | 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)=""
|
---|
23 | F BA="BNDRY","HEAD","HEAD(0)","PAGE","PARRY(","PARRAY(","QAMFIN","SARRY(","SARRAY(","TODAY" S ZTSAVE(BA)=""
|
---|
24 | Q
|
---|