| 1 | PSGOE ;BIR/CML3-PROFILE AND ORDER ENTRY (MAIN DRIVER) ;24 Feb 99 / 10:40 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**22,29,56,72,95,80,133**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191
|
|---|
| 5 | ; Reference to ^PSSLOCK is supported by DBIA #2789
|
|---|
| 6 | ;
|
|---|
| 7 | ;N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
|
|---|
| 8 | ;
|
|---|
| 9 | EN ;
|
|---|
| 10 | N PSJLK,PSJPROT,XQORS,VALMEVL,PSJSYSO D ENCV^PSGSETU Q:$D(XQUIT)
|
|---|
| 11 | S (PSGOL,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" I $P(PSJSYSU,";",2)&($P(PSJSYSU,";")'=3) S PSGION=ION D DDEV D ^%ZISC I DDEV="^" G DONE
|
|---|
| 12 | K PSGVBY L +^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE
|
|---|
| 13 | F S (PSJLMCON,PSGPTMP)=0 D ENDPT^PSGP,HK Q:PSGP'>0 D I PSJLK D UL^PSSLOCK(PSGP)
|
|---|
| 14 | .K ^TMP("PSJ",$J)
|
|---|
| 15 | .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
|
|---|
| 16 | .N NXTPT S NXTPT=0 ;NXTPT=1 indicates OE is complete for this patient
|
|---|
| 17 | .K PSJLMPRO S PSJLMCON=0
|
|---|
| 18 | .S PSJPROT=1,DFN=PSGP D EN^VALM("PSJ LM BRIEF PATIENT INFO")
|
|---|
| 19 | .F Q:$G(NXTPT) D
|
|---|
| 20 | ..K PSGRDTX
|
|---|
| 21 | ..I $G(PSJLMCON)!$G(PSJNEWOE) D
|
|---|
| 22 | ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
|
|---|
| 23 | ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJU LM OE")
|
|---|
| 24 | ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q
|
|---|
| 25 | ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D Q
|
|---|
| 26 | ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO")
|
|---|
| 27 | ...I $G(PSJNEWOE) S NXTPT=0 Q
|
|---|
| 28 | ...S NXTPT=1
|
|---|
| 29 | ..S NXTPT=1,PSJNEWOE=0 ; Go on to next patient
|
|---|
| 30 | .I $G(PSGPXN),$P(PSJSYSW0,U,29)]"" S PSGPXPT=PSGP D K PSGPXPT S PSGPXN=0
|
|---|
| 31 | ..N DFN,PSGP S (PSGP,DFN)=PSGPXPT D ^PSGPER
|
|---|
| 32 | .D ENCV^PSGSETU
|
|---|
| 33 | K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)
|
|---|
| 34 | ;
|
|---|
| 35 | DONE ;
|
|---|
| 36 | I PSGOP,$P(PSJSYSL,"^",2)]"" D ENQL^PSGLW
|
|---|
| 37 | I $D(PSJSYSO),PSGOP,$O(^PS(53.44,DUZ,1,PSGOP,1,0)) S PSGOEPOF="" D ^PSGOEPO
|
|---|
| 38 | K D0,DDEV,FQC,J,MRN,ND,ND2,PSGNEF,PSGNEFDO,PSGNESDO,PSGOE,PSGOEA,PSGOEAV,PSGOEDMR,PSGOENOF,PSGOEPOF,PSGOL,PSGOP,PSGPX,PSGTOL,PSGTOO,PSGUOW,PSJOPC,PSJORTOU,PSJORVP,PRI,PX,XX L -^PS(53.45,PSJSYSP)
|
|---|
| 39 | K PSGOEORF,ORIFN,ORETURN,PSJORL,PSJORPCL,PSJORPV,PSJNOO,DDH,DDN,DRGI,FQ,HF,I1,ND1,NF,PDRG,PSGACTO,PSGAL,PSGCANFL,PSGDA,PSGPEN,PSGPENWS,PSGY
|
|---|
| 40 | G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND1,PSG25,PSG26,PSGEB,PSBEBN,PSGNODE,PSGOAT,PSGSTAT,DDN,I2 Q
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | HK ; Housekeeping (a nice COBOL term)
|
|---|
| 44 | S PSGOENOF=0 I +PSJSYSU=1 D NOW^%DTC F Q=%:0 Q:PSGOENOF S Q=$O(^PS(55,PSGP,5,"AUS",Q)) Q:'Q F QQ=0:0 S QQ=$O(^PS(55,PSGP,5,"AUS",Q,QQ)) Q:'QQ I $D(^PS(55,PSGP,5,QQ,4)),$P(^(4),"^",10) S PSGOENOF=1 Q
|
|---|
| 45 | I PSGOP,PSGOP'=PSGP D
|
|---|
| 46 | .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
|
|---|
| 47 | .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,"^",2)]"" ENQL^PSGLW
|
|---|
| 48 | I $D(PSJSYSO),PSGOP,PSGOP'=PSGP S PSGOEPOF="" D ^PSGOEPO
|
|---|
| 49 | S:PSGP>0 PSJORVP=PSGP_";DPT(",PSJORL=$$ENORL^PSJUTL(PSJPWD),PSGOP=PSGP,X=""
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | ORSU ; Oe/Rr Set-Up ;Not used anymore
|
|---|
| 53 | ;K %ZIS,IO("Q") S IOP="HOME" D ^%ZIS
|
|---|
| 54 | ;S PSGOEORF=$O(^DIC(9.4,"B","INPATIENT MEDICATIONS",0)) I PSGOEORF S PSGOEORF=$S($D(^ORD(100.99,1,20,PSGOEORF,0)):$P(^(0),"^",2),1:0)
|
|---|
| 55 | ;I PSGOEORF S PSJORTOU=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",0)),PSJORPCL=$O(^ORD(101,"B","PSJ OR PAT OE",0)),PSJORPCL=PSJORPCL_";ORD(101,"
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | DDEV ;
|
|---|
| 59 | F S POP=1 R !!,"Select Device to print ORDERS (10-1158): ",DDEV:DTIME W:'$T $C(7) S:'$T DDEV="^" Q:DDEV="^"!(DDEV=".") D:DDEV?1."?" DDH K %ZIS,IO("Q") S %ZIS="NQ",IOP=DDEV D ^%ZIS Q:'POP
|
|---|
| 60 | S:DDEV="^" %=-1 Q:POP I $E(IOST)'="P"!(PSGION=ION) W $C(7),!!?2,"The device you have selected is not a printer. You must select a printer." W:PSGION=ION !,"You cannot print the orders to your terminal." G DDEV
|
|---|
| 61 | S PSJSYSO=ION_"^"_IO W:$S(DDEV=" ":1,$L(DDEV)'<$L(ION):0,1:DDEV=$E(ION,1,$L(DDEV))) $S(DDEV=" ":" "_ION,1:$E(ION,$L(DDEV)+1,$L(ION)))
|
|---|
| 62 | F Q=0:0 S Q=$O(^PS(53.44,DUZ,1,Q)) Q:'Q I $O(^(Q,1,0)) Q
|
|---|
| 63 | Q:'Q W !!?2,"You have unprinted orders. If you do not print them now, you will not be",!,"able to print them from here later."
|
|---|
| 64 | F W !!,"Do you want to print them now" S %=1 D YN^DICN Q:% W !!?2,"Enter 'YES' to print the orders now. If you enter 'NO', you will not be",!,"able to print them from here later. (Enter '^' to exit this option.)"
|
|---|
| 65 | Q:%<0 I %=1 S PSGOEPOF="A" D ^PSGOEPO S %=0 Q
|
|---|
| 66 | S DA=DUZ,DIK="^PS(53.44," D ^DIK S %=0 Q
|
|---|
| 67 | ;
|
|---|
| 68 | DDH ;
|
|---|
| 69 | W !!?2,"Select a device to print each patient's orders (VA Form 10-1158) after you",!,"have entered them. If you do not select a device, no orders will print." Q
|
|---|
| 70 | ;
|
|---|
| 71 | CHUCK ;
|
|---|
| 72 | D ENCV^PSGSETU Q:$D(XQUIT) R !!,"PSJSYSU: ",PSJSYSU:DTIME S:'$T PSJSYSU="^" I "^"'[PSJSYSU G EN
|
|---|
| 73 | Q
|
|---|
