| [613] | 1 | QAOSWRK0 ;HISC/DAD-WORKSHEET DRIVER ROUTINE ;6/15/93 10:18
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | D HOME^%ZIS
|
|---|
| 4 | ASKTYPE ;
|
|---|
| 5 | K DIR S DIR(0)="LO^1:4^K:X[""."" X",DIR("A")="Select Worksheet Type(s)"
|
|---|
| 6 | S DIR("?")="Select the type(s) of worksheet(s) you want printed, e.g., 1,2 or 1-4"
|
|---|
| 7 | S DIR("?",1)="Choose from:",DIR("?",2)=" 1 Clinical worksheet"
|
|---|
| 8 | S DIR("?",3)=" 2 Peer worksheet",DIR("?",4)=" 3 Management worksheet"
|
|---|
| 9 | S DIR("?",5)=" 4 Committee worksheet",DIR("?",6)=""
|
|---|
| 10 | W ! K DIRUT D ^DIR K DIR G:$D(DIRUT) EXIT S QAOSTYPE=$E(Y,1,$L(Y)-1)
|
|---|
| 11 | ASKHOW ;
|
|---|
| 12 | K DIR S DIR(0)="SOB^1:Patient(s);2:Date Range;3:Blank"
|
|---|
| 13 | S DIR("A")="How do you want the worksheet(s) printed"
|
|---|
| 14 | S DIR("A",1)="Enter 1 to print the worksheet(s) for selected patient(s), or"
|
|---|
| 15 | S DIR("A",2)="Enter 2 to print the worksheet(s) for a range of dates, or"
|
|---|
| 16 | S DIR("A",3)="Enter 3 to print completely blank worksheets.",DIR("A",4)=""
|
|---|
| 17 | W ! K DIRUT D ^DIR K DIR G:$D(DIRUT) EXIT S QAOSHOW=Y,QAOSQUIT=0
|
|---|
| 18 | W:QAOSHOW=1 ! K ^TMP($J,"PATLIST") S (QAOSREC,QAOSQUIT,QAQQUIT)=0
|
|---|
| 19 | I QAOSHOW=3 D ASKCOPY G EXIT:QAOSQUIT,DEV
|
|---|
| 20 | D ^QAQDATE:QAOSHOW=2,ASKPAT:QAOSHOW=1 G EXIT:QAOSQUIT!QAQQUIT
|
|---|
| 21 | ASKDATA ;
|
|---|
| 22 | K DIR S DIR(0)="SOB^1:Blank;2:With Data"
|
|---|
| 23 | S DIR("A")="Choose",DIR("A",1)="Enter 1 to print blank worksheets, or"
|
|---|
| 24 | S DIR("A",2)="Enter 2 to print worksheets for reviews currently in process/complete",DIR("A",3)="",DIR("B")=1
|
|---|
| 25 | W ! K DIRUT D ^DIR K DIR G:$D(DIRUT) EXIT S QAOSDATA=Y
|
|---|
| 26 | DEV ;
|
|---|
| 27 | K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
|
|---|
| 28 | I $D(IO("Q")) D G EXIT
|
|---|
| 29 | . S ZTRTN="ENTSK^QAOSWRK0",ZTDESC="PRINT OCCURRENCE SCREEN WORKSHEETS"
|
|---|
| 30 | . S ZTSAVE("QAO*")="",ZTSAVE("QAQ*")="",ZTSAVE("^TMP($J,")=""
|
|---|
| 31 | . D ^%ZTLOAD
|
|---|
| 32 | . Q
|
|---|
| 33 | ENTSK ;
|
|---|
| 34 | U IO D BLNKLOOP:QAOSHOW=3,DATELOOP:QAOSHOW=2,PATLOOP:QAOSHOW=1
|
|---|
| 35 | EXIT ;
|
|---|
| 36 | W ! S IONOFF=1 D ^%ZISC K ^TMP($J,"PATLIST")
|
|---|
| 37 | K %ZIS,DIC,DIR,DIRUT,IONOFF,LOC,OCCDATE,PATNAM,POP,QA,QAOSD,QAOSDATA
|
|---|
| 38 | K QAOSDSEL,QAOSD0,QAOSHOW,QAOSQUIT,QAOSREC,QAOSTYPE,SCRN,X,Y,ZTDESC
|
|---|
| 39 | K ZTRTN,ZTSAVE,LEN,LOCDPT,LOCQA,REVR,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I,Y,Z
|
|---|
| 40 | K QAOSMDUE,QAOSMDAY,HEADER,IEN405,LOC405,NAME,QAODC,QAODFN,QAODT,QAOSDFN
|
|---|
| 41 | K QAOSI,QAOSWHEN,QAOTS,SCREEN,SRV,SSN,UNDL,UNSC,WARD,QAOSCOPY,QAOCOPYS
|
|---|
| 42 | K QAOSONE,QAOSPDUE,QAOSPDAY,QAOSS0
|
|---|
| 43 | D KVAR^VADPT,K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 44 | Q
|
|---|
| 45 | ASKCOPY ;
|
|---|
| 46 | K DIR S DIR(0)="NAO^1:10:0"
|
|---|
| 47 | S DIR("A")="How many copies of each worksheet do you want: ",DIR("B")=1
|
|---|
| 48 | S DIR("?",1)="Enter the number of copies of each worksheet you want printed."
|
|---|
| 49 | S DIR("?")="Your answer must be from 1 to 10."
|
|---|
| 50 | W ! D ^DIR S QAOSQUIT=$S($D(DIRUT):1,$D(DIRUT):1,1:0),QAOCOPYS=Y
|
|---|
| 51 | Q
|
|---|
| 52 | BLNKLOOP ;
|
|---|
| 53 | F QAOSCOPY=1:1:QAOCOPYS S (QAOSQUIT,QAOSD0)=0,QAOSDATA=1 D CALLROU
|
|---|
| 54 | Q
|
|---|
| 55 | DATELOOP ;
|
|---|
| 56 | S QAOSQUIT=0 F QAOSD=QAQNBEG-.000001:0 S QAOSD=$O(^QA(741,"C",QAOSD)) Q:(QAOSD'>0)!(QAOSD>QAQNEND)!QAOSQUIT F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSD,QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D:$D(^QA(741,"AD",2,QAOSD0))[0 CALLROU
|
|---|
| 57 | Q
|
|---|
| 58 | ASKPAT ;
|
|---|
| 59 | W !,$S(QAOSREC:"Another one: ",1:"Select PATIENT: ")
|
|---|
| 60 | R X:DTIME S:'$T X="^" S QAOSQUIT=$S(X="^":1,1:0)
|
|---|
| 61 | I X=""!QAOSQUIT S:'QAOSREC QAOSQUIT=1 Q
|
|---|
| 62 | I $E(X)="?" W @IOF,!!?3,"Select a patient by name or SSN. To deselect a patient type a minus (-)",!?3,"sign and the patient name or SSN, e.g. -DOE,JOHN" D PATLIST
|
|---|
| 63 | S DIC="^QA(741,",DIC(0)="EMQ",DIC("S")="I $P(^(0),""^"",11)<2"
|
|---|
| 64 | S QAOSDSEL=0 S:$E(X)="-" QAOSDSEL=1,X=$E(X,2,999)
|
|---|
| 65 | D ^DIC K DIC("S") G:+Y=-1 ASKPAT
|
|---|
| 66 | I QAOSDSEL S:QAOSREC QAOSREC=QAOSREC-1 K ^TMP($J,"PATLIST",+Y)
|
|---|
| 67 | E S QAOSREC=QAOSREC+1,^TMP($J,"PATLIST",+Y)=""
|
|---|
| 68 | G ASKPAT
|
|---|
| 69 | PATLIST ;
|
|---|
| 70 | S QAOSQUIT=0 W:QAOSREC !!," YOU HAVE ALREADY SELECTED:"
|
|---|
| 71 | F QAOSD0=0:0 S QAOSD0=$O(^TMP($J,"PATLIST",QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D PATDISP
|
|---|
| 72 | W ! Q
|
|---|
| 73 | PATDISP ;
|
|---|
| 74 | S LOC=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN"))
|
|---|
| 75 | S PATNAM=+LOC,PATNAM=$S($D(^DPT(PATNAM,0))#2:$P(^(0),"^"),1:PATNAM)
|
|---|
| 76 | S Y=$P(LOC,"^",3) X ^DD("DD") S OCCDATE=Y
|
|---|
| 77 | S SCRN=$S($D(^QA(741.1,SCRN,0))#2:+^(0),1:SCRN)
|
|---|
| 78 | W !?5,PATNAM,?30,OCCDATE,?50,SCRN
|
|---|
| 79 | I $Y>(IOSL-4) K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0) I 'QAOSQUIT W:$O(^TMP($J,"PATLIST",QAOSD0))>0 @IOF,!," YOU HAVE ALREADY SELECTED:"
|
|---|
| 80 | Q
|
|---|
| 81 | PATLOOP ;
|
|---|
| 82 | S QAOSQUIT=0 F QAOSD0=0:0 S QAOSD0=$O(^TMP($J,"PATLIST",QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D CALLROU
|
|---|
| 83 | Q
|
|---|
| 84 | CALLROU ;
|
|---|
| 85 | D:QAOSTYPE["1" ^QAOSPCL0 Q:QAOSQUIT D:QAOSTYPE["1" ^QAOSPCL1 Q:QAOSQUIT D:QAOSTYPE["2" ^QAOSPPR0 Q:QAOSQUIT D:QAOSTYPE["3" ^QAOSPMG0 Q:QAOSQUIT D:QAOSTYPE["4" ^QAOSPCM0
|
|---|
| 86 | Q
|
|---|
