- QAOUTL0 ;HISC/DAD-OCCURRENCE SCREEN UTILITIES ;2/4/93 08:45
- ;;3.0;Occurrence Screen;;09/14/1993
- ENDISP ;
- N X,Y,UNDL,QAOS,QAOSDFN,QAOSZERO,QAOSWARD,QAOSDATE,QAOSPDUE,QAOSMDUE,QAOSSCRN
- S:$D(QAOSWHAT)[0 QAOSWHAT="REVIEWED"
- K UNDL S $P(UNDL,"-",18+$L(QAOSWHAT))=""
- S QAOSZERO=$G(^QA(741,QAOSD0,0))
- S QAOSDFN=$S($D(^DPT(+QAOSZERO,0))#2:$P(^(0),"^"),1:+QAOSZERO)
- S QAOSWARD=+$P(QAOSZERO,"^",5),QAOSWARD=$P($G(^SC(QAOSWARD,0)),"^")
- S Y=$P(QAOSZERO,"^",3) D DD^%DT S QAOSDATE=Y
- S Y=$P(QAOSZERO,"^",12) X ^DD("DD") S QAOSPDUE=Y
- S Y=$P(QAOSZERO,"^",13) X ^DD("DD") S QAOSMDUE=Y
- S QAOS=QAOSPDUE_QAOSMDUE
- S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
- S QAOSSCRN=$S($D(^QA(741.1,QAOSSCRN,0))#2:^(0),1:QAOSSCRN)
- S QAOSSCRN=$P(QAOSSCRN,"^")_" "_$P(QAOSSCRN,"^",2)
- W @IOF
- W !!?5,"OCCURRENCE BEING ",QAOSWHAT W:QAOS]"" ?51,"REVIEW DUE DATES"
- W !?5,UNDL W:QAOS]"" ?51,"----------------"
- W !?5,"NAME : ",QAOSDFN W:QAOS]"" ?51,"PEER : ",QAOSPDUE
- W !?5,"WARD/CLINIC : ",QAOSWARD W:QAOS]"" ?51,"MGMT : ",QAOSMDUE
- W !?5,"DATE : ",QAOSDATE
- W !?5,"SCREEN : ",QAOSSCRN,!
- Q
- ENCHOS ;
- R !!,"Select OPEN, CLOSED, or BOTH types of occurrences? BOTH// ",QAOSTYPE:DTIME S:'$T QAOSTYPE="^"
- S QAOSQUIT=$S($E(QAOSTYPE)="^":1,1:0) Q:QAOSQUIT
- S X=QAOSTYPE X ^%ZOSF("UPPERCASE") S QAOSTYPE=Y
- I $F("^BOTH^OPEN^CLOSED","^"_QAOSTYPE)'>0 D G ENCHOS
- . W:$E(QAOSTYPE)'="?" " ??",*7 W !
- . W !?5,"Valid entries are OPEN, CLOSED, BOTH, or Up-Arrow (^) to exit."
- . W !?10,"Enter OPEN to select occurrences whose status is open."
- . W !?10,"Enter CLOSED to select occurrences whose status is closed."
- . W !?10,"Enter BOTH to select both OPEN and CLOSED occurrences."
- . W !?10,"Enter Up-Arrow (^) to EXIT."
- . Q
- W $P($P("^BOTH^OPEN^CLOSED^","^"_QAOSTYPE,2),"^")
- S QAOSTYPE=$S(QAOSTYPE["B":"",1:$E(QAOSTYPE))
- S QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)"_$S(QAOSTYPE="O":"=0",QAOSTYPE="C":"=1",1:"<2")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOUTL0 1938 printed Jan 18, 2025@03:23:27 Page 2
- QAOUTL0 ;HISC/DAD-OCCURRENCE SCREEN UTILITIES ;2/4/93 08:45
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- ENDISP ;
- +1 NEW X,Y,UNDL,QAOS,QAOSDFN,QAOSZERO,QAOSWARD,QAOSDATE,QAOSPDUE,QAOSMDUE,QAOSSCRN
- +2 if $DATA(QAOSWHAT)[0
- SET QAOSWHAT="REVIEWED"
- +3 KILL UNDL
- SET $PIECE(UNDL,"-",18+$LENGTH(QAOSWHAT))=""
- +4 SET QAOSZERO=$GET(^QA(741,QAOSD0,0))
- +5 SET QAOSDFN=$SELECT($DATA(^DPT(+QAOSZERO,0))#2:$PIECE(^(0),"^"),1:+QAOSZERO)
- +6 SET QAOSWARD=+$PIECE(QAOSZERO,"^",5)
- SET QAOSWARD=$PIECE($GET(^SC(QAOSWARD,0)),"^")
- +7 SET Y=$PIECE(QAOSZERO,"^",3)
- DO DD^%DT
- SET QAOSDATE=Y
- +8 SET Y=$PIECE(QAOSZERO,"^",12)
- XECUTE ^DD("DD")
- SET QAOSPDUE=Y
- +9 SET Y=$PIECE(QAOSZERO,"^",13)
- XECUTE ^DD("DD")
- SET QAOSMDUE=Y
- +10 SET QAOS=QAOSPDUE_QAOSMDUE
- +11 SET QAOSSCRN=+$GET(^QA(741,QAOSD0,"SCRN"))
- +12 SET QAOSSCRN=$SELECT($DATA(^QA(741.1,QAOSSCRN,0))#2:^(0),1:QAOSSCRN)
- +13 SET QAOSSCRN=$PIECE(QAOSSCRN,"^")_" "_$PIECE(QAOSSCRN,"^",2)
- +14 WRITE @IOF
- +15 WRITE !!?5,"OCCURRENCE BEING ",QAOSWHAT
- if QAOS]""
- WRITE ?51,"REVIEW DUE DATES"
- +16 WRITE !?5,UNDL
- if QAOS]""
- WRITE ?51,"----------------"
- +17 WRITE !?5,"NAME : ",QAOSDFN
- if QAOS]""
- WRITE ?51,"PEER : ",QAOSPDUE
- +18 WRITE !?5,"WARD/CLINIC : ",QAOSWARD
- if QAOS]""
- WRITE ?51,"MGMT : ",QAOSMDUE
- +19 WRITE !?5,"DATE : ",QAOSDATE
- +20 WRITE !?5,"SCREEN : ",QAOSSCRN,!
- +21 QUIT
- ENCHOS ;
- +1 READ !!,"Select OPEN, CLOSED, or BOTH types of occurrences? BOTH// ",QAOSTYPE:DTIME
- if '$TEST
- SET QAOSTYPE="^"
- +2 SET QAOSQUIT=$SELECT($EXTRACT(QAOSTYPE)="^":1,1:0)
- if QAOSQUIT
- QUIT
- +3 SET X=QAOSTYPE
- XECUTE ^%ZOSF("UPPERCASE")
- SET QAOSTYPE=Y
- +4 IF $FIND("^BOTH^OPEN^CLOSED","^"_QAOSTYPE)'>0
- Begin DoDot:1
- +5 if $EXTRACT(QAOSTYPE)'="?"
- WRITE " ??",*7
- WRITE !
- +6 WRITE !?5,"Valid entries are OPEN, CLOSED, BOTH, or Up-Arrow (^) to exit."
- +7 WRITE !?10,"Enter OPEN to select occurrences whose status is open."
- +8 WRITE !?10,"Enter CLOSED to select occurrences whose status is closed."
- +9 WRITE !?10,"Enter BOTH to select both OPEN and CLOSED occurrences."
- +10 WRITE !?10,"Enter Up-Arrow (^) to EXIT."
- +11 QUIT
- End DoDot:1
- GOTO ENCHOS
- +12 WRITE $PIECE($PIECE("^BOTH^OPEN^CLOSED^","^"_QAOSTYPE,2),"^")
- +13 SET QAOSTYPE=$SELECT(QAOSTYPE["B":"",1:$EXTRACT(QAOSTYPE))
- +14 SET QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)"_$SELECT(QAOSTYPE="O":"=0",QAOSTYPE="C":"=1",1:"<2")
- +15 QUIT