PSGORVW.m

PSGORVW ;BIR/CML3-UNIT DOSE EXPANDED VIEW FOR OE/RR ;04 APR 94 / 11:06 AM

 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97

 ;

 ; Reference to ^PSDRUG is supported by DBIA 2191.

 ;

EN(PSGP,PSGORD) ;

 N AT,D,DRG,F,FL,HSM,Q,R,ST,SM,ST,UD,X,Y

 S $P(FL,"-",80)="",F="^PS("_$S(PSGORD["N":"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","

 S ST=$G(@(F_"0)")),AT=$G(^(2)),Y=$P($G(^(6)),"^")

 S SM=$P(ST,"^",4),HSM=$P(ST,"^",5),ST=$S($P(ST,"^",9)="P":"",1:$P(ST,"^",7)),AT=$P(AT,"^",5) S:Y]"" Y=$$ENSET^PSGSICHK(Y)

 ;

WRT ;

 W !,"Schedule Type:",?22,$$ENSTN^PSGMI(ST)

 W !,"Admin Times:",?22,$S(AT:AT,1:"NOT FOUND")

 W !,"Self Med:",?22,$P("NO^YES","^",SM+1) I SM,HSM W "  (HOSPITAL SUPPLIED)"

 W !,"Special Instructions:",?22 I Y]"" F Q=1:1:$L(Y) S X=$P(Y," ",Q) W:$L(X)+$X>78 !?22 W X_" "

 W !?48,"Units",?56,"Units",?64,"Inactive",!," Dispensed Drugs",?43,"U/D",?48,"Disp'd",?56,"Ret'd",?64,"Date",!,FL

 F X=0:0 S X=$O(@(F_"1,"_X_")")) Q:'X  S DRG=$G(^(X,0)) I DRG]"" D  ;

 .S UD=$P(DRG,"^",2),D=$P(DRG,"^",6)+$P(DRG,"^",10)+$P(DRG,"^",12),R=+$P(DRG,"^",7),Y=$P(DRG,"^",3) I Y S Y=$$ENDTC^PSGMI(Y)

 .S DRG=$S(DRG="":"NOT FOUND",'DRG:$P(DRG,"^"),$P($G(^PSDRUG(+DRG,0)),"^")]"":$P(^(0),"^"),1:$P(DRG,"^")_";PSDRUG(")

 .W !?1,DRG,?43,$S(UD:UD,1:1),?48,D,?56,R W:Y ?64,Y Q

 I $O(@(F_"12,0)")) W !!,"Provider Comments:" F Q=0:0 S Q=$O(@(F_"12,"_Q_")")) Q:'Q  N Y,Y2 S Y=" "_^(Q,0) F KKA=2:1 S Y2=$P(Y," ",KKA) Q:Y2=""  W:$L(Y2)+$X>79 !?2 W " ",Y2

 K KKA

 I $O(@(F_"3,0)")) W !!,"Comments:" F Q=0:0 S Q=$O(@(F_"3,"_Q_")")) Q:'Q  W !?2,^(Q,0)

 ;

DONE ;

 Q

PSGORVW   ;BIR/CML3-UNIT DOSE EXPANDED VIEW FOR OE/RR ;04 APR 94 / 11:06 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PSDRUG is supported by DBIA 2191.

 +4       ;

EN(PSGP,PSGORD) ;

 +1        NEW AT,D,DRG,F,FL,HSM,Q,R,ST,SM,ST,UD,X,Y

 +2        SET $PIECE(FL,"-",80)=""

           SET F="^PS("_$SELECT(PSGORD["N":"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","

 +3        SET ST=$GET(@(F_"0)"))

           SET AT=$GET(^(2))

           SET Y=$PIECE($GET(^(6)),"^")

 +4        SET SM=$PIECE(ST,"^",4)

           SET HSM=$PIECE(ST,"^",5)

           SET ST=$SELECT($PIECE(ST,"^",9)="P":"",1:$PIECE(ST,"^",7))

           SET AT=$PIECE(AT,"^",5)

           IF Y]""

               SET Y=$$ENSET^PSGSICHK(Y)

 +5       ;

WRT       ;

 +1        WRITE !,"Schedule Type:",?22,$$ENSTN^PSGMI(ST)

 +2        WRITE !,"Admin Times:",?22,$SELECT(AT:AT,1:"NOT FOUND")

 +3        WRITE !,"Self Med:",?22,$PIECE("NO^YES","^",SM+1)

           IF SM

               IF HSM

                   WRITE "  (HOSPITAL SUPPLIED)"

 +4        WRITE !,"Special Instructions:",?22

           IF Y]""

               FOR Q=1:1:$LENGTH(Y)

                   SET X=$PIECE(Y," ",Q)

                   IF $LENGTH(X)+$X>78

                       WRITE !?22

                   WRITE X_" "

 +5        WRITE !?48,"Units",?56,"Units",?64,"Inactive",!," Dispensed Drugs",?43,"U/D",?48,"Disp'd",?56,"Ret'd",?64,"Date",!,FL

 +6       ;

           FOR X=0:0

               SET X=$ORDER(@(F_"1,"_X_")"))

               IF 'X

                   QUIT 

               SET DRG=$GET(^(X,0))

               IF DRG]""

                   Begin DoDot:1

 +7                    SET UD=$PIECE(DRG,"^",2)

                       SET D=$PIECE(DRG,"^",6)+$PIECE(DRG,"^",10)+$PIECE(DRG,"^",12)

                       SET R=+$PIECE(DRG,"^",7)

                       SET Y=$PIECE(DRG,"^",3)

                       IF Y

                           SET Y=$$ENDTC^PSGMI(Y)

 +8                    SET DRG=$SELECT(DRG="":"NOT FOUND",'DRG:$PIECE(DRG,"^"),$PIECE($GET(^PSDRUG(+DRG,0)),"^")]"":$PIECE(^(0),"^"),1:$PIECE(DRG,"^")_";PSDRUG(")

 +9                    WRITE !?1,DRG,?43,$SELECT(UD:UD,1:1),?48,D,?56,R

                       IF Y

                           WRITE ?64,Y

                       QUIT 

                   End DoDot:1

 +10       IF $ORDER(@(F_"12,0)"))

               WRITE !!,"Provider Comments:"

               FOR Q=0:0

                   SET Q=$ORDER(@(F_"12,"_Q_")"))

                   IF 'Q

                       QUIT 

                   NEW Y,Y2

                   SET Y=" "_^(Q,0)

                   FOR KKA=2:1

                       SET Y2=$PIECE(Y," ",KKA)

                       IF Y2=""

                           QUIT 

                       IF $LENGTH(Y2)+$X>79

                           WRITE !?2

                       WRITE " ",Y2

 +11       KILL KKA

 +12       IF $ORDER(@(F_"3,0)"))

               WRITE !!,"Comments:"

               FOR Q=0:0

                   SET Q=$ORDER(@(F_"3,"_Q_")"))

                   IF 'Q

                       QUIT 

                   WRITE !?2,^(Q,0)

 +13      ;

DONE      ;

 +1        QUIT