QAMAHO1 ;HISC/GJC-REPORTS FOR FALLOUT FILE ;11/15/94 13:47
;;1.0;Clinical Monitoring System;**3**;09/13/1993
;
D KILL,HOME^%ZIS S (CNT,CNTR,QAMEXIT)=0
F QAM0=0:0 D ASKSRT Q:QAMOUT
I QAMEXIT D KILL Q
K CHOICE F QAM0=0:0 D ASKPRT Q:QAMOUT
I $D(PARRY),$D(SARRY) D ^QAMAHO3
KILL F QA="DATE","DLMNT","ELEMENT","IEN","MON","PAT","SUB","TEMP" K ^UTILITY($J,"QAM "_QA)
K %,%DT,CD,CNT,CNTR,DATA1,DATA2,DIR,DIRUT,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,DTOUT,DUP,DUOUT,EF,ELEM,FIELD,GC,IEN,JD,LABEL1,LABEL2,LIMIT,LOOP,LP,LP0,LP1,MN,MN1
K MON,MON1,MON2,MONI,NAME1,NAME2,PAGE,PARRY,PCPY,PNT,POP,PRNT,PTNT,QA,QAM0,QAM1,QAM2,QAMD0,QAMDATA,QAMDIEN,QAMDT,QAMEXIT,QAMFIN,QAML,QAMLP,QAMOUT,QAMPT,QAMQUIT,QAQQUIT,QAMTYPE
K QAM1HED,QAM2HED,QAMENGD,QAQNBEG,QAQNEND,QAMRANG,QAMTART,QAMX,SARRY,SCPY,SORT,SUB,SUB1,SUB2,TODAY,YZ,ZTSAVE,Z,ZZZ,ELEMENT,QAMCD,SARRAY,QAQQUIT,QAMELEM,CHOICE,PARRAY,QA,X1,X2,C,QADIRPNT
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
ASKSRT ;
S QAMOUT=0,LIMIT=4
W:CNTR'=2 @IOF W:CNTR=0 !!?15,"Enter the fields you wish to sort on. "
I CNTR=2 W !!?15,"Maximum of two sort fields reached!!",*7 R ZZZ:3 S QAMOUT=1 Q
I CNTR>0 W !?15,"Select next field to sort on. "
W !?15,"Maximum two sort fields allowed." W:CNTR>0 !?15,"* indicates already selected." D DISP W !!?15,"Sort selection #",CNTR+1_": "
R SORT:DTIME
I 'CNTR,(SORT="") D VOID G ASKSRT:%=2 W:QAMOUT !!?15,*7,"Exiting without a report." Q:QAMOUT
S:SORT="" QAMOUT=1 S:SORT["^" (QAMEXIT,QAMOUT)=1 Q:QAMOUT!(QAMEXIT)
I SORT'?1N.N!(SORT<1)!(SORT>4) D MSSG G ASKSRT
S CNTR=CNTR+1,FIELD=$P($T(ZFLDS+SORT),U,2) D CHSRT G:SCPY ASKSRT S SARRY(CNTR)=+FIELD
D PAT^QAMAHO2:SORT=1,MON^QAMAHO2:SORT=2,EVENT^QAMAHO5:SORT=3,DLMNT^QAMAHO2:SORT=4
I QAMOUT K SARRY(CNTR),SARRAY(CNTR),CHOICE(+FIELD) S CNTR=CNTR-$S(CNTR:1,1:0) G ASKSRT
S SARRAY(CNTR)=$P(FIELD," ",2,99),CHOICE(+FIELD)=CNTR S:SORT=4 SARRAY(CNTR)=QAMDATA
Q
ASKPRT ;
S QAMOUT=0,LIMIT=4
W:CNT'=4 @IOF W:CNT=0 !!?15,"Enter the fields you wish to print."
I CNT=4 W !!?15,"Maximum of four print fields reached!!",*7 R ZZZ:3 S QAMOUT=1 Q
I CNT>0 W !?15,"Select next field to print on. "
W !?15,"Maximum four print fields allowed. " W:CNT>0 !?15,"* indicates already selected." D DISP W !!?15,"Print selection # ",CNT+1_": "
R PRNT:DTIME
I 'CNT,(PRNT="") D VOID G ASKPRT:%=2 W:QAMOUT !!?15,*7,"Exiting without a report." Q:QAMOUT
S:PRNT="" QAMOUT=1 S:PRNT["^" (QAMEXIT,QAMOUT)=1 Q:QAMOUT!(QAMEXIT)
I PRNT'?1N.N!(PRNT<1)!(PRNT>4) D MSSG G ASKPRT
S CNT=CNT+1,FIELD=$P($T(ZFLDS+PRNT),U,2) D CHPRT G:PCPY ASKPRT S PARRY(CNT)=+FIELD,(PARRAY(+FIELD),CHOICE(+FIELD))=CNT
I PRNT=4 S QAQDIC="^QA(743.4,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select DATA ELEMENT: ",QAQUTIL="QAM ELEMENT" D EN1^QAQSELCT I QAQQUIT K PARRY(CNT),CHOICE(+FIELD) S CNT=CNT-$S(CNT:1,1:0),(QAMQUIT,QAQQUIT)=0
Q
CHPRT ;
S PCPY=0 F LP=1:1:CNT I $D(PARRY(LP)),(PARRY(LP)=+FIELD) S PCPY=1,CNT=CNT-$S(CNT:1,1:0) Q
W:PCPY !!?5,*7,"You have previously chosen `",$P(FIELD," ",2,99),"' to print. " R:PCPY ZZZ:3
Q
CHSRT ;
S SCPY=0 F LP=1:1:CNTR I $D(SARRY(LP)),(SARRY(LP)=+FIELD) S SCPY=1,CNTR=CNTR-$S(CNTR:1,1:0) Q
W:SCPY !!?5,*7,"You have previously chosen `",$P(FIELD," ",2,99),"' to sort on. " R:SCPY ZZZ:3
Q
DISP ;
W ! F QAML=1:1:2 S X=$P($T(ZFLDS+QAML),U,2) W !,+X,$S($D(CHOICE(+X))#2:" * ",1:" "),$P(X," ",2) S X=$P($T(ZFLDS+QAML+2),U,2) W ?40,+X,$S($D(CHOICE(+X))#2:" * ",1:" "),$P(X," ",2)
Q
MSSG ;
W *7," ??",!!?15,"Enter a number between 1 - "_LIMIT_". " R ZZZ:3
Q
VOID ;
W !!?15,*7,"You have not selected any sort or print data.",!?15,"Do you wish to exit the program" K DTOUT S %=1 D YN^DICN I (%=1)!(%=-1) S (QAMEXIT,QAMOUT)=1
I %=0 W !,*7,?15,"""Y"" for Yes, ""N"" for No " G VOID
Q
ZFLDS ;;
;;^1 Patient Name
;;^2 Monitor
;;^3 Event Date
;;^4 Data Element
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAHO1 3846 printed Dec 13, 2024@01:41:34 Page 2
QAMAHO1 ;HISC/GJC-REPORTS FOR FALLOUT FILE ;11/15/94 13:47
+1 ;;1.0;Clinical Monitoring System;**3**;09/13/1993
+2 ;
+3 DO KILL
DO HOME^%ZIS
SET (CNT,CNTR,QAMEXIT)=0
+4 FOR QAM0=0:0
DO ASKSRT
if QAMOUT
QUIT
+5 IF QAMEXIT
DO KILL
QUIT
+6 KILL CHOICE
FOR QAM0=0:0
DO ASKPRT
if QAMOUT
QUIT
+7 IF $DATA(PARRY)
IF $DATA(SARRY)
DO ^QAMAHO3
KILL FOR QA="DATE","DLMNT","ELEMENT","IEN","MON","PAT","SUB","TEMP"
KILL ^UTILITY($JOB,"QAM "_QA)
+1 KILL %,%DT,CD,CNT,CNTR,DATA1,DATA2,DIR,DIRUT,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,DTOUT,DUP,DUOUT,EF,ELEM,FIELD,GC,IEN,JD,LABEL1,LABEL2,LIMIT,LOOP,LP,LP0,LP1,MN,MN1
+2 KILL MON,MON1,MON2,MONI,NAME1,NAME2,PAGE,PARRY,PCPY,PNT,POP,PRNT,PTNT,QA,QAM0,QAM1,QAM2,QAMD0,QAMDATA,QAMDIEN,QAMDT,QAMEXIT,QAMFIN,QAML,QAMLP,QAMOUT,QAMPT,QAMQUIT,QAQQUIT,QAMTYPE
+3 KILL QAM1HED,QAM2HED,QAMENGD,QAQNBEG,QAQNEND,QAMRANG,QAMTART,QAMX,SARRY,SCPY,SORT,SUB,SUB1,SUB2,TODAY,YZ,ZTSAVE,Z,ZZZ,ELEMENT,QAMCD,SARRAY,QAQQUIT,QAMELEM,CHOICE,PARRAY,QA,X1,X2,C,QADIRPNT
+4 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
ASKSRT ;
+1 SET QAMOUT=0
SET LIMIT=4
+2 if CNTR'=2
WRITE @IOF
if CNTR=0
WRITE !!?15,"Enter the fields you wish to sort on. "
+3 IF CNTR=2
WRITE !!?15,"Maximum of two sort fields reached!!",*7
READ ZZZ:3
SET QAMOUT=1
QUIT
+4 IF CNTR>0
WRITE !?15,"Select next field to sort on. "
+5 WRITE !?15,"Maximum two sort fields allowed."
if CNTR>0
WRITE !?15,"* indicates already selected."
DO DISP
WRITE !!?15,"Sort selection #",CNTR+1_": "
+6 READ SORT:DTIME
+7 IF 'CNTR
IF (SORT="")
DO VOID
if %=2
GOTO ASKSRT
if QAMOUT
WRITE !!?15,*7,"Exiting without a report."
if QAMOUT
QUIT
+8 if SORT=""
SET QAMOUT=1
if SORT["^"
SET (QAMEXIT,QAMOUT)=1
if QAMOUT!(QAMEXIT)
QUIT
+9 IF SORT'?1N.N!(SORT<1)!(SORT>4)
DO MSSG
GOTO ASKSRT
+10 SET CNTR=CNTR+1
SET FIELD=$PIECE($TEXT(ZFLDS+SORT),U,2)
DO CHSRT
if SCPY
GOTO ASKSRT
SET SARRY(CNTR)=+FIELD
+11 if SORT=1
DO PAT^QAMAHO2
if SORT=2
DO MON^QAMAHO2
if SORT=3
DO EVENT^QAMAHO5
if SORT=4
DO DLMNT^QAMAHO2
+12 IF QAMOUT
KILL SARRY(CNTR),SARRAY(CNTR),CHOICE(+FIELD)
SET CNTR=CNTR-$SELECT(CNTR:1,1:0)
GOTO ASKSRT
+13 SET SARRAY(CNTR)=$PIECE(FIELD," ",2,99)
SET CHOICE(+FIELD)=CNTR
if SORT=4
SET SARRAY(CNTR)=QAMDATA
+14 QUIT
ASKPRT ;
+1 SET QAMOUT=0
SET LIMIT=4
+2 if CNT'=4
WRITE @IOF
if CNT=0
WRITE !!?15,"Enter the fields you wish to print."
+3 IF CNT=4
WRITE !!?15,"Maximum of four print fields reached!!",*7
READ ZZZ:3
SET QAMOUT=1
QUIT
+4 IF CNT>0
WRITE !?15,"Select next field to print on. "
+5 WRITE !?15,"Maximum four print fields allowed. "
if CNT>0
WRITE !?15,"* indicates already selected."
DO DISP
WRITE !!?15,"Print selection # ",CNT+1_": "
+6 READ PRNT:DTIME
+7 IF 'CNT
IF (PRNT="")
DO VOID
if %=2
GOTO ASKPRT
if QAMOUT
WRITE !!?15,*7,"Exiting without a report."
if QAMOUT
QUIT
+8 if PRNT=""
SET QAMOUT=1
if PRNT["^"
SET (QAMEXIT,QAMOUT)=1
if QAMOUT!(QAMEXIT)
QUIT
+9 IF PRNT'?1N.N!(PRNT<1)!(PRNT>4)
DO MSSG
GOTO ASKPRT
+10 SET CNT=CNT+1
SET FIELD=$PIECE($TEXT(ZFLDS+PRNT),U,2)
DO CHPRT
if PCPY
GOTO ASKPRT
SET PARRY(CNT)=+FIELD
SET (PARRAY(+FIELD),CHOICE(+FIELD))=CNT
+11 IF PRNT=4
SET QAQDIC="^QA(743.4,"
SET QAQDIC(0)="AEMNQZ"
SET QAQDIC("A")="Select DATA ELEMENT: "
SET QAQUTIL="QAM ELEMENT"
DO EN1^QAQSELCT
IF QAQQUIT
KILL PARRY(CNT),CHOICE(+FIELD)
SET CNT=CNT-$SELECT(CNT:1,1:0)
SET (QAMQUIT,QAQQUIT)=0
+12 QUIT
CHPRT ;
+1 SET PCPY=0
FOR LP=1:1:CNT
IF $DATA(PARRY(LP))
IF (PARRY(LP)=+FIELD)
SET PCPY=1
SET CNT=CNT-$SELECT(CNT:1,1:0)
QUIT
+2 if PCPY
WRITE !!?5,*7,"You have previously chosen `",$PIECE(FIELD," ",2,99),"' to print. "
if PCPY
READ ZZZ:3
+3 QUIT
CHSRT ;
+1 SET SCPY=0
FOR LP=1:1:CNTR
IF $DATA(SARRY(LP))
IF (SARRY(LP)=+FIELD)
SET SCPY=1
SET CNTR=CNTR-$SELECT(CNTR:1,1:0)
QUIT
+2 if SCPY
WRITE !!?5,*7,"You have previously chosen `",$PIECE(FIELD," ",2,99),"' to sort on. "
if SCPY
READ ZZZ:3
+3 QUIT
DISP ;
+1 WRITE !
FOR QAML=1:1:2
SET X=$PIECE($TEXT(ZFLDS+QAML),U,2)
WRITE !,+X,$SELECT($DATA(CHOICE(+X))#2:" * ",1:" "),$PIECE(X," ",2)
SET X=$PIECE($TEXT(ZFLDS+QAML+2),U,2)
WRITE ?40,+X,$SELECT($DATA(CHOICE(+X))#2:" * ",1:" "),$PIECE(X," ",2)
+2 QUIT
MSSG ;
+1 WRITE *7," ??",!!?15,"Enter a number between 1 - "_LIMIT_". "
READ ZZZ:3
+2 QUIT
VOID ;
+1 WRITE !!?15,*7,"You have not selected any sort or print data.",!?15,"Do you wish to exit the program"
KILL DTOUT
SET %=1
DO YN^DICN
IF (%=1)!(%=-1)
SET (QAMEXIT,QAMOUT)=1
+2 IF %=0
WRITE !,*7,?15,"""Y"" for Yes, ""N"" for No "
GOTO VOID
+3 QUIT
ZFLDS ;;
+1 ;;^1 Patient Name
+2 ;;^2 Monitor
+3 ;;^3 Event Date
+4 ;;^4 Data Element
