QAOSPINQ ;HISC/DAD-OCCURRENCE SCREEN PATIENT INQUIRE ;6/11/93 15:52
;;3.0;Occurrence Screen;;09/14/1993
S QAQDIC="^QA(741,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select PATIENT: "
S QAQUTIL="QAOSPINQ" D ^QAQSELCT G:QAQQUIT EXIT
K %ZIS,IOP S %ZIS="MNQ" W ! D ^%ZIS G:POP EXIT
I $D(IO("Q")) K IO("Q") D G EXIT
. S ZTRTN="ENTSK^QAOSPINQ",ZTDESC="Occurrence Screen Patient Inquire"
. S ZTSAVE("^UTILITY($J,")="" D ^%ZTLOAD
. Q
ENTSK ; TASKED ENTRY POINT
S QAOSQUIT=0,QAOSNAME="",QAOSIOST=IOST
S QAOSIOP=ION_";"_IOST_";"_IOM_";"_IOSL
S %X="^UTILITY($J,""QAOSPINQ"",",%Y="^TMP($J,""QAOSPINQ""," D %XY^%RCR
F S QAOSNAME=$O(^TMP($J,"QAOSPINQ",QAOSNAME)) Q:QAOSNAME=""!QAOSQUIT F QAOSD0=0:0 S QAOSD0=$O(^TMP($J,"QAOSPINQ",QAOSNAME,QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D
. S DIC="^QA(741,",BY="@NUMBER",(FR,TO)=QAOSD0,FLDS="[CAPTIONED]",L=0
. S IOP=QAOSIOP D EN1^DIP
. I $E(QAOSIOST)="C" K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
. Q
EXIT ;
K %ZIS,BY,DIC,DIR,FLDS,FR,P,POP,QAOSD0,QAOSIOP,QAOSQUIT,QAQDIC,QAQQUIT
K QAOSIOST,QAOSNAME,QAQUTIL,TO,Y,ZTDESC,ZTRTN,ZTSAVEE
K ^TMP($J,"QAOSPINQ"),^UTILITY($J,"QAOSPINQ")
D HOME^%ZIS S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPINQ 1188 printed Dec 13, 2024@02:21:44 Page 2
QAOSPINQ ;HISC/DAD-OCCURRENCE SCREEN PATIENT INQUIRE ;6/11/93 15:52
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 SET QAQDIC="^QA(741,"
SET QAQDIC(0)="AEMNQZ"
SET QAQDIC("A")="Select PATIENT: "
+3 SET QAQUTIL="QAOSPINQ"
DO ^QAQSELCT
if QAQQUIT
GOTO EXIT
+4 KILL %ZIS,IOP
SET %ZIS="MNQ"
WRITE !
DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+6 SET ZTRTN="ENTSK^QAOSPINQ"
SET ZTDESC="Occurrence Screen Patient Inquire"
+7 SET ZTSAVE("^UTILITY($J,")=""
DO ^%ZTLOAD
+8 QUIT
End DoDot:1
GOTO EXIT
ENTSK ; TASKED ENTRY POINT
+1 SET QAOSQUIT=0
SET QAOSNAME=""
SET QAOSIOST=IOST
+2 SET QAOSIOP=ION_";"_IOST_";"_IOM_";"_IOSL
+3 SET %X="^UTILITY($J,""QAOSPINQ"","
SET %Y="^TMP($J,""QAOSPINQ"","
DO %XY^%RCR
+4 FOR
SET QAOSNAME=$ORDER(^TMP($JOB,"QAOSPINQ",QAOSNAME))
if QAOSNAME=""!QAOSQUIT
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^TMP($JOB,"QAOSPINQ",QAOSNAME,QAOSD0))
if QAOSD0'>0!QAOSQUIT
QUIT
Begin DoDot:1
+5 SET DIC="^QA(741,"
SET BY="@NUMBER"
SET (FR,TO)=QAOSD0
SET FLDS="[CAPTIONED]"
SET L=0
+6 SET IOP=QAOSIOP
DO EN1^DIP
+7 IF $EXTRACT(QAOSIOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+8 QUIT
End DoDot:1
EXIT ;
+1 KILL %ZIS,BY,DIC,DIR,FLDS,FR,P,POP,QAOSD0,QAOSIOP,QAOSQUIT,QAQDIC,QAQQUIT
+2 KILL QAOSIOST,QAOSNAME,QAQUTIL,TO,Y,ZTDESC,ZTRTN,ZTSAVEE
+3 KILL ^TMP($JOB,"QAOSPINQ"),^UTILITY($JOB,"QAOSPINQ")
+4 DO HOME^%ZIS
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
