Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAOUTL0

QAOUTL0.m

Go to the documentation of this file.
  1. QAOUTL0 ;HISC/DAD-OCCURRENCE SCREEN UTILITIES ;2/4/93 08:45
  1. ;;3.0;Occurrence Screen;;09/14/1993
  1. ENDISP ;
  1. N X,Y,UNDL,QAOS,QAOSDFN,QAOSZERO,QAOSWARD,QAOSDATE,QAOSPDUE,QAOSMDUE,QAOSSCRN
  1. S:$D(QAOSWHAT)[0 QAOSWHAT="REVIEWED"
  1. K UNDL S $P(UNDL,"-",18+$L(QAOSWHAT))=""
  1. S QAOSZERO=$G(^QA(741,QAOSD0,0))
  1. S QAOSDFN=$S($D(^DPT(+QAOSZERO,0))#2:$P(^(0),"^"),1:+QAOSZERO)
  1. S QAOSWARD=+$P(QAOSZERO,"^",5),QAOSWARD=$P($G(^SC(QAOSWARD,0)),"^")
  1. S Y=$P(QAOSZERO,"^",3) D DD^%DT S QAOSDATE=Y
  1. S Y=$P(QAOSZERO,"^",12) X ^DD("DD") S QAOSPDUE=Y
  1. S Y=$P(QAOSZERO,"^",13) X ^DD("DD") S QAOSMDUE=Y
  1. S QAOS=QAOSPDUE_QAOSMDUE
  1. S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
  1. S QAOSSCRN=$S($D(^QA(741.1,QAOSSCRN,0))#2:^(0),1:QAOSSCRN)
  1. S QAOSSCRN=$P(QAOSSCRN,"^")_" "_$P(QAOSSCRN,"^",2)
  1. W @IOF
  1. W !!?5,"OCCURRENCE BEING ",QAOSWHAT W:QAOS]"" ?51,"REVIEW DUE DATES"
  1. W !?5,UNDL W:QAOS]"" ?51,"----------------"
  1. W !?5,"NAME : ",QAOSDFN W:QAOS]"" ?51,"PEER : ",QAOSPDUE
  1. W !?5,"WARD/CLINIC : ",QAOSWARD W:QAOS]"" ?51,"MGMT : ",QAOSMDUE
  1. W !?5,"DATE : ",QAOSDATE
  1. W !?5,"SCREEN : ",QAOSSCRN,!
  1. Q
  1. ENCHOS ;
  1. R !!,"Select OPEN, CLOSED, or BOTH types of occurrences? BOTH// ",QAOSTYPE:DTIME S:'$T QAOSTYPE="^"
  1. S QAOSQUIT=$S($E(QAOSTYPE)="^":1,1:0) Q:QAOSQUIT
  1. S X=QAOSTYPE X ^%ZOSF("UPPERCASE") S QAOSTYPE=Y
  1. I $F("^BOTH^OPEN^CLOSED","^"_QAOSTYPE)'>0 D G ENCHOS
  1. . W:$E(QAOSTYPE)'="?" " ??",*7 W !
  1. . W !?5,"Valid entries are OPEN, CLOSED, BOTH, or Up-Arrow (^) to exit."
  1. . W !?10,"Enter OPEN to select occurrences whose status is open."
  1. . W !?10,"Enter CLOSED to select occurrences whose status is closed."
  1. . W !?10,"Enter BOTH to select both OPEN and CLOSED occurrences."
  1. . W !?10,"Enter Up-Arrow (^) to EXIT."
  1. . Q
  1. W $P($P("^BOTH^OPEN^CLOSED^","^"_QAOSTYPE,2),"^")
  1. S QAOSTYPE=$S(QAOSTYPE["B":"",1:$E(QAOSTYPE))
  1. S QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)"_$S(QAOSTYPE="O":"=0",QAOSTYPE="C":"=1",1:"<2")
  1. Q