PSGVBW1.m

PSGVBW1 ;BIR/CML3,MV-NON-VERFIED ORDERS UTILITES ;03 Jul 2003  7:19 AM

 ;;5.0; INPATIENT MEDICATIONS ;**5,111**;16 DEC 97

 ;

 ;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

 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

PSGVBW1   ;BIR/CML3,MV-NON-VERFIED ORDERS UTILITES ;03 Jul 2003  7:19 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**5,111**;16 DEC 97

 +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        DO ^PSGVBW0

 +8        SET Y=-1

 +9        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