- PSGVBW1 ;BIR/CML3,MV-NON-VERFIED ORDERS UTILITES ; 5/3/10 3:44pm
- ;;5.0; INPATIENT MEDICATIONS ;**5,111,241**;16 DEC 97;Build 10
- ;
- ;Reference to ^PS(55 is supported by DBIA 2191.
- ;
- ENPROF ;
- I +PSJSYSU=1 S PSGOENOF=0 D NOW^%DTC F Q=%:0 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
- W !!,$S($P(PSGP(0),"^")]"":$P(PSGP(0),"^"),1:PSGP_";DPT(") W:PSJPBID " (",PSJPBID,")"
- D ENL^PSGOU Q:PSGOL["^"
- K ZTSAVE S PSGTIR="^PSJAC,^PSGO",ZTDESC="PATIENT PROFILE",PSGPR=1 F X="PSGP","PSGP(0)","PSGPR","PSGOL","PSGPTMP","PPAGE" S ZTSAVE(X)=""
- Q:PSGOL="N"
- D ENDEV^PSGTI K PSGPR Q:POP!$D(IO("Q"))
- S PSGVBW=IO'=IO(0)!($E(IOST)'="C") D ^PSGO D ^%ZISC Q:PSGVBW
- PEND K DIR S DIR(0)="E" W ! D ^DIR K DIR Q
- ;
- OUTPT ;Set up Outpatient IV for non/ver pending option.
- K ^TMP("PSGVBW",$J)
- NEW PSJSTAT,PSJTOO1,PSJPAC1
- ;I PSJTOO'=2 S PSJSTAT="N" D PSGP
- ;I PSJTOO'=1 S PSJSTAT="P" D PSGP
- S PSJSTAT="N" D PSGP
- S PSJSTAT="P" D PSGP
- N PSJXR,PSJUDIV S PSJXR(1)=$S(+PSJSYSU=3:"APV",1:"ANV"),PSJXR(2)=$S(+PSJSYSU=3:"APIV",1:"ANIV") ;*PSJ*5*241: added block
- F PSJUDIV=1:1:2 F DFN=0:0 S DFN=$O(^PS(55,PSJXR(PSJUDIV),DFN)) Q:'DFN D
- . NEW VAIN D INP^VADPT
- . I $G(VAIN(4))&(PSGSS="G"&'$D(^PS(57.5,"AB",+VAIN(4)))) D
- .. S PSGP=DFN D ^PSJAC S WDN="ZZ" D IF^PSGVBW
- D ^PSGVBW0
- S Y=-1
- Q
- PSGP ;
- F PSGP=0:0 S PSGP=$O(^PS(53.1,"AS",PSJSTAT,PSGP)) Q:'PSGP D
- . NEW VAIN S DFN=PSGP D INP^VADPT
- . I '+(VAIN(4))!(PSGSS="G"&'$D(^PS(57.5,"AB",+VAIN(4)))) D
- .. ;I PSJSTAT="N",'+VAIN(4) Q
- .. D ^PSJAC S WDN="ZZ" D IF^PSGVBW
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVBW1 1637 printed Feb 18, 2025@23:29:49 Page 2
- PSGVBW1 ;BIR/CML3,MV-NON-VERFIED ORDERS UTILITES ; 5/3/10 3:44pm
- +1 ;;5.0; INPATIENT MEDICATIONS ;**5,111,241**;16 DEC 97;Build 10
- +2 ;
- +3 ;Reference to ^PS(55 is supported by DBIA 2191.
- +4 ;
- ENPROF ;
- +1 IF +PSJSYSU=1
- SET PSGOENOF=0
- DO NOW^%DTC
- FOR Q=%:0
- 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 WRITE !!,$SELECT($PIECE(PSGP(0),"^")]"":$PIECE(PSGP(0),"^"),1:PSGP_";DPT(")
- if PSJPBID
- WRITE " (",PSJPBID,")"
- +3 DO ENL^PSGOU
- if PSGOL["^"
- QUIT
- +4 KILL ZTSAVE
- SET PSGTIR="^PSJAC,^PSGO"
- SET ZTDESC="PATIENT PROFILE"
- SET PSGPR=1
- FOR X="PSGP","PSGP(0)","PSGPR","PSGOL","PSGPTMP","PPAGE"
- SET ZTSAVE(X)=""
- +5 if PSGOL="N"
- QUIT
- +6 DO ENDEV^PSGTI
- KILL PSGPR
- if POP!$DATA(IO("Q"))
- QUIT
- +7 SET PSGVBW=IO'=IO(0)!($EXTRACT(IOST)'="C")
- DO ^PSGO
- DO ^%ZISC
- if PSGVBW
- QUIT
- PEND KILL DIR
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- QUIT
- +1 ;
- OUTPT ;Set up Outpatient IV for non/ver pending option.
- +1 KILL ^TMP("PSGVBW",$JOB)
- +2 NEW PSJSTAT,PSJTOO1,PSJPAC1
- +3 ;I PSJTOO'=2 S PSJSTAT="N" D PSGP
- +4 ;I PSJTOO'=1 S PSJSTAT="P" D PSGP
- +5 SET PSJSTAT="N"
- DO PSGP
- +6 SET PSJSTAT="P"
- DO PSGP
- +7 ;*PSJ*5*241: added block
- NEW PSJXR,PSJUDIV
- SET PSJXR(1)=$SELECT(+PSJSYSU=3:"APV",1:"ANV")
- SET PSJXR(2)=$SELECT(+PSJSYSU=3:"APIV",1:"ANIV")
- +8 FOR PSJUDIV=1:1:2
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,PSJXR(PSJUDIV),DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +9 NEW VAIN
- DO INP^VADPT
- +10 IF $GET(VAIN(4))&(PSGSS="G"&'$DATA(^PS(57.5,"AB",+VAIN(4))))
- Begin DoDot:2
- +11 SET PSGP=DFN
- DO ^PSJAC
- SET WDN="ZZ"
- DO IF^PSGVBW
- End DoDot:2
- End DoDot:1
- +12 DO ^PSGVBW0
- +13 SET Y=-1
- +14 QUIT
- PSGP ;
- +1 FOR PSGP=0:0
- SET PSGP=$ORDER(^PS(53.1,"AS",PSJSTAT,PSGP))
- if 'PSGP
- QUIT
- Begin DoDot:1
- +2 NEW VAIN
- SET DFN=PSGP
- DO INP^VADPT
- +3 IF '+(VAIN(4))!(PSGSS="G"&'$DATA(^PS(57.5,"AB",+VAIN(4))))
- Begin DoDot:2
- +4 ;I PSJSTAT="N",'+VAIN(4) Q
- +5 DO ^PSJAC
- SET WDN="ZZ"
- DO IF^PSGVBW
- End DoDot:2
- End DoDot:1
- +6 QUIT
