- PSGOE ;BIR/CML3-PROFILE AND ORDER ENTRY (MAIN DRIVER) ;24 Feb 99 / 10:40 AM
- ;;5.0; INPATIENT MEDICATIONS ;**22,29,56,72,95,80,133**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191
- ; Reference to ^PSSLOCK is supported by DBIA #2789
- ;
- ;N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
- ;
- EN ;
- N PSJLK,PSJPROT,XQORS,VALMEVL,PSJSYSO D ENCV^PSGSETU Q:$D(XQUIT)
- S (PSGOL,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" I $P(PSJSYSU,";",2)&($P(PSJSYSU,";")'=3) S PSGION=ION D DDEV D ^%ZISC I DDEV="^" G DONE
- K PSGVBY L +^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE
- F S (PSJLMCON,PSGPTMP)=0 D ENDPT^PSGP,HK Q:PSGP'>0 D I PSJLK D UL^PSSLOCK(PSGP)
- .K ^TMP("PSJ",$J)
- .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
- .N NXTPT S NXTPT=0 ;NXTPT=1 indicates OE is complete for this patient
- .K PSJLMPRO S PSJLMCON=0
- .S PSJPROT=1,DFN=PSGP D EN^VALM("PSJ LM BRIEF PATIENT INFO")
- .F Q:$G(NXTPT) D
- ..K PSGRDTX
- ..I $G(PSJLMCON)!$G(PSJNEWOE) D
- ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
- ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJU LM OE")
- ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q
- ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D Q
- ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO")
- ...I $G(PSJNEWOE) S NXTPT=0 Q
- ...S NXTPT=1
- ..S NXTPT=1,PSJNEWOE=0 ; Go on to next patient
- .I $G(PSGPXN),$P(PSJSYSW0,U,29)]"" S PSGPXPT=PSGP D K PSGPXPT S PSGPXN=0
- ..N DFN,PSGP S (PSGP,DFN)=PSGPXPT D ^PSGPER
- .D ENCV^PSGSETU
- K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)
- ;
- DONE ;
- I PSGOP,$P(PSJSYSL,"^",2)]"" D ENQL^PSGLW
- I $D(PSJSYSO),PSGOP,$O(^PS(53.44,DUZ,1,PSGOP,1,0)) S PSGOEPOF="" D ^PSGOEPO
- 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)
- K PSGOEORF,ORIFN,ORETURN,PSJORL,PSJORPCL,PSJORPV,PSJNOO,DDH,DDN,DRGI,FQ,HF,I1,ND1,NF,PDRG,PSGACTO,PSGAL,PSGCANFL,PSGDA,PSGPEN,PSGPENWS,PSGY
- G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND1,PSG25,PSG26,PSGEB,PSBEBN,PSGNODE,PSGOAT,PSGSTAT,DDN,I2 Q
- Q
- ;
- HK ; Housekeeping (a nice COBOL term)
- 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
- I PSGOP,PSGOP'=PSGP D
- .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
- .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,"^",2)]"" ENQL^PSGLW
- I $D(PSJSYSO),PSGOP,PSGOP'=PSGP S PSGOEPOF="" D ^PSGOEPO
- S:PSGP>0 PSJORVP=PSGP_";DPT(",PSJORL=$$ENORL^PSJUTL(PSJPWD),PSGOP=PSGP,X=""
- Q
- ;
- ORSU ; Oe/Rr Set-Up ;Not used anymore
- ;K %ZIS,IO("Q") S IOP="HOME" D ^%ZIS
- ;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)
- ;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,"
- Q
- ;
- DDEV ;
- 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
- 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
- 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)))
- F Q=0:0 S Q=$O(^PS(53.44,DUZ,1,Q)) Q:'Q I $O(^(Q,1,0)) Q
- 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."
- 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.)"
- Q:%<0 I %=1 S PSGOEPOF="A" D ^PSGOEPO S %=0 Q
- S DA=DUZ,DIK="^PS(53.44," D ^DIK S %=0 Q
- ;
- DDH ;
- 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
- ;
- CHUCK ;
- D ENCV^PSGSETU Q:$D(XQUIT) R !!,"PSJSYSU: ",PSJSYSU:DTIME S:'$T PSJSYSU="^" I "^"'[PSJSYSU G EN
- Q
- PSGOE ;BIR/CML3-PROFILE AND ORDER ENTRY (MAIN DRIVER) ;24 Feb 99 / 10:40 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**22,29,56,72,95,80,133**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191
- +4 ; Reference to ^PSSLOCK is supported by DBIA #2789
- +5 ;
- +6 ;N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
- +7 ;
- EN ;
- +1 NEW PSJLK,PSJPROT,XQORS,VALMEVL,PSJSYSO
- DO ENCV^PSGSETU
- IF $DATA(XQUIT)
- QUIT
- +2 SET (PSGOL,PSGOP,PSGNEF,PSGOEAV,PSGPXN)=""
- IF $PIECE(PSJSYSU,";",2)&($PIECE(PSJSYSU,";")'=3)
- SET PSGION=ION
- DO DDEV
- DO ^%ZISC
- IF DDEV="^"
- GOTO DONE
- +3 KILL PSGVBY
- LOCK +^PS(53.45,PSJSYSP):1
- IF '$TEST
- DO LOCKERR^PSJOE
- GOTO DONE
- +4 FOR
- SET (PSJLMCON,PSGPTMP)=0
- DO ENDPT^PSGP
- DO HK
- IF PSGP'>0
- QUIT
- Begin DoDot:1
- +5 KILL ^TMP("PSJ",$JOB)
- +6 SET PSJLK=$$L^PSSLOCK(PSGP,1)
- IF 'PSJLK
- WRITE !,$CHAR(7),$PIECE(PSJLK,U,2)
- QUIT
- +7 ;NXTPT=1 indicates OE is complete for this patient
- NEW NXTPT
- SET NXTPT=0
- +8 KILL PSJLMPRO
- SET PSJLMCON=0
- +9 SET PSJPROT=1
- SET DFN=PSGP
- DO EN^VALM("PSJ LM BRIEF PATIENT INFO")
- +10 FOR
- IF $GET(NXTPT)
- QUIT
- Begin DoDot:2
- +11 KILL PSGRDTX
- +12 IF $GET(PSJLMCON)!$GET(PSJNEWOE)
- Begin DoDot:3
- +13 SET PSJOL=$SELECT(",S,L,"[(","_$GET(PSJOL)_","):PSJOL,1:"S")
- +14 SET PSJLMPRO=1
- SET PSJLMCON=1
- SET PSJNEWOE=0
- DO EN^VALM("PSJU LM OE")
- End DoDot:3
- +15 IF $GET(PSJNEWOE)!($GET(VALMBCK)="Q")
- SET PSJNEWOE=0
- QUIT
- +16 IF $GET(PSJLMCON)&$GET(PSJLMPRO)&'$DATA(^TMP("PSJ",$JOB))
- Begin DoDot:3
- +17 SET PSJLMCON=0
- SET PSJLMPRO=0
- DO EN^VALM("PSJ LM BRIEF PATIENT INFO")
- +18 IF $GET(PSJNEWOE)
- SET NXTPT=0
- QUIT
- +19 SET NXTPT=1
- End DoDot:3
- QUIT
- +20 ; Go on to next patient
- SET NXTPT=1
- SET PSJNEWOE=0
- End DoDot:2
- +21 IF $GET(PSGPXN)
- IF $PIECE(PSJSYSW0,U,29)]""
- SET PSGPXPT=PSGP
- Begin DoDot:2
- +22 NEW DFN,PSGP
- SET (PSGP,DFN)=PSGPXPT
- DO ^PSGPER
- End DoDot:2
- KILL PSGPXPT
- SET PSGPXN=0
- +23 DO ENCV^PSGSETU
- End DoDot:1
- IF PSJLK
- DO UL^PSSLOCK(PSGP)
- +24 KILL PSJLMPRO,^TMP("PSJPRO",$JOB),^TMP("PSJ",$JOB),^TMP("PSJON",$JOB)
- +25 ;
- DONE ;
- +1 IF PSGOP
- IF $PIECE(PSJSYSL,"^",2)]""
- DO ENQL^PSGLW
- +2 IF $DATA(PSJSYSO)
- IF PSGOP
- IF $ORDER(^PS(53.44,DUZ,1,PSGOP,1,0))
- SET PSGOEPOF=""
- DO ^PSGOEPO
- +3 KILL 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
- LOCK -^PS(53.45,PSJSYSP)
- +4 KILL PSGOEORF,ORIFN,ORETURN,PSJORL,PSJORPCL,PSJORPV,PSJNOO,DDH,DDN,DRGI,FQ,HF,I1,ND1,NF,PDRG,PSGACTO,PSGAL,PSGCANFL,PSGDA,PSGPEN,PSGPENWS,PSGY
- +5 IF $GET(PSGPXN)
- GOTO ^PSGPER1
- DO ENKV^PSGSETU
- KILL ND1,PSG25,PSG26,PSGEB,PSBEBN,PSGNODE,PSGOAT,PSGSTAT,DDN,I2
- QUIT
- +6 QUIT
- +7 ;
- HK ; Housekeeping (a nice COBOL term)
- +1 SET PSGOENOF=0
- IF +PSJSYSU=1
- DO NOW^%DTC
- FOR Q=%:0
- IF PSGOENOF
- QUIT
- SET Q=$ORDER(^PS(55,PSGP,5,"AUS",Q))
- IF 'Q
- QUIT
- FOR QQ=0:0
- SET QQ=$ORDER(^PS(55,PSGP,5,"AUS",Q,QQ))
- IF 'QQ
- QUIT
- IF $DATA(^PS(55,PSGP,5,QQ,4))
- IF $PIECE(^(4),"^",10)
- SET PSGOENOF=1
- QUIT
- +2 IF PSGOP
- IF PSGOP'=PSGP
- Begin DoDot:1
- +3 NEW PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR
- SET DFN=PSGOP
- +4 DO INP^VADPT
- SET PSJPWD=+VAIN(4)
- IF PSJPWD
- SET PSJACPF=10
- DO WP^PSJAC
- IF $PIECE(PSJSYSL,"^",2)]""
- DO ENQL^PSGLW
- End DoDot:1
- +5 IF $DATA(PSJSYSO)
- IF PSGOP
- IF PSGOP'=PSGP
- SET PSGOEPOF=""
- DO ^PSGOEPO
- +6 IF PSGP>0
- SET PSJORVP=PSGP_";DPT("
- SET PSJORL=$$ENORL^PSJUTL(PSJPWD)
- SET PSGOP=PSGP
- SET X=""
- +7 QUIT
- +8 ;
- ORSU ; Oe/Rr Set-Up ;Not used anymore
- +1 ;K %ZIS,IO("Q") S IOP="HOME" D ^%ZIS
- +2 ;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)
- +3 ;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,"
- +4 QUIT
- +5 ;
- DDEV ;
- +1 FOR
- SET POP=1
- READ !!,"Select Device to print ORDERS (10-1158): ",DDEV:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET DDEV="^"
- IF DDEV="^"!(DDEV=".")
- QUIT
- IF DDEV?1."?"
- DO DDH
- KILL %ZIS,IO("Q")
- SET %ZIS="NQ"
- SET IOP=DDEV
- DO ^%ZIS
- IF 'POP
- QUIT
- +2 IF DDEV="^"
- SET %=-1
- IF POP
- QUIT
- IF $EXTRACT(IOST)'="P"!(PSGION=ION)
- WRITE $CHAR(7),!!?2,"The device you have selected is not a printer. You must select a printer."
- IF PSGION=ION
- WRITE !,"You cannot print the orders to your terminal."
- GOTO DDEV
- +3 SET PSJSYSO=ION_"^"_IO
- IF $SELECT(DDEV=" "
- WRITE $SELECT(DDEV=" ":" "_ION,1:$EXTRACT(ION,$LENGTH(DDEV)+1,$LENGTH(ION)))
- +4 FOR Q=0:0
- SET Q=$ORDER(^PS(53.44,DUZ,1,Q))
- IF 'Q
- QUIT
- IF $ORDER(^(Q,1,0))
- QUIT
- +5 IF 'Q
- QUIT
- WRITE !!?2,"You have unprinted orders. If you do not print them now, you will not be",!,"able to print them from here later."
- +6 FOR
- WRITE !!,"Do you want to print them now"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- WRITE !!?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.)"
- +7 IF %<0
- QUIT
- IF %=1
- SET PSGOEPOF="A"
- DO ^PSGOEPO
- SET %=0
- QUIT
- +8 SET DA=DUZ
- SET DIK="^PS(53.44,"
- DO ^DIK
- SET %=0
- QUIT
- +9 ;
- DDH ;
- +1 WRITE !!?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."
- QUIT
- +2 ;
- CHUCK ;
- +1 DO ENCV^PSGSETU
- IF $DATA(XQUIT)
- QUIT
- READ !!,"PSJSYSU: ",PSJSYSU:DTIME
- IF '$TEST
- SET PSJSYSU="^"
- IF "^"'[PSJSYSU
- GOTO EN
- +2 QUIT
