QAMAHO1.m

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 ---QAMAHO1   3846     printed  Apr 23, 2025@17:56:01                                                                                                                                                                                                     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