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 Dec 13, 2024@02:22:16 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
