PSGWCAD.m

PSGWCAD ;BHAM ISC/PTD,CML-Calculate and Store AMIS Data ; 29 Dec 93 / 9:13 AM

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 ;Calling routine passes these variables: PSGWADT -AMIS Date, PSGWDN -drug number, PSGWQD -quantity dispensed, PSGWCAT -AMIS category, PSGWAOU -AOU for returns, SITE -for INPATIENT SITE for AOU.

 ;IF COMPLETE DATA IS NOT AVAILABLE, SET MISSING DATA FLAG. DO RECALC.

CHKDTA S INC=0 I PSGWCAT="R" I '$D(^PSI(58.1,PSGWAOU,0)) W !!,"Data missing - contact ADP personnel.",!,"The zero node for this AOU is missing.",!!,"No AMIS update made for this return!" G END

 I PSGWCAT="R" S LOC3=^PSI(58.1,PSGWAOU,0),PSGWCAT=PSGWCAT_$S($P(LOC3,"^",2)="W":"W",1:"A")

 I $D(^PSDRUG(PSGWDN,660)) S LOC1=^(660)

 E  S INC=1 D RECALC G END

 I $D(^PSDRUG(PSGWDN,"PSG")) S LOC2=^("PSG")

 E  S INC=1 D RECALC G END

 F J=3,5,6 I $P(LOC1,"^",J)="" S INC=1 D RECALC G END

 F J=2,3 I $P(LOC2,"^",J)="" S INC=1 D RECALC G END

 ;

MAIN D CALC I PSGWCAT["R" D SETRET,RECALC G END

 D SETDSP,RECALC

END K INC,LOC1,LOC2,LOC3,J,DOSE,COST,FLD,CAT,DTDA,DRGDA,FLDA,DA,DR,GOTIT S PSGWCAT=$E(PSGWCAT)

 Q

 ;

CALC ;COMPLETE DATA IS AVAILABLE, SO CALCULATE AMIS DATA.

 S DOSE=PSGWQD*$P(LOC2,"^",3),COST=PSGWQD*$P(LOC1,"^",6)

 I PSGWCAT="A" S FLD=$S($P(LOC2,"^",2)=0:"04",$P(LOC2,"^",2)=1:"07",$P(LOC2,"^",2)=2:"17",1:"22")

 I PSGWCAT="W" S FLD=$S($P(LOC2,"^",2)=0:"03",$P(LOC2,"^",2)=1:"06",$P(LOC2,"^",2)=2:"17",1:"22")

 I PSGWCAT["R" S FLD=$S($P(LOC3,"^",2)="W":$S($P(LOC2,"^",2)=0:"03",$P(LOC2,"^",2)=1:"06",$P(LOC2,"^",2)=2:"17",1:"22"),1:$S($P(LOC2,"^",2)=0:"04",$P(LOC2,"^",2)=1:"07",$P(LOC2,"^",2)=2:"17",1:"22"))

 Q

 ;

SETDSP ;

 D NEW S:'$D(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",0)) ^(0)="^58.51S^^"

 I '$D(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD)) S DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""AMIS"",",DIC(0)="LM",X=FLD,DA(2)=PSGWADT,DA(1)=SITE,DIC("DR")="1///"_DOSE_";2///"_COST K DD,DO D FILE^DICN K DIC Q

 S FLDA=$O(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD,0)),$P(^(0),"^",2)=$P(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",FLDA,0),"^",2)+DOSE,$P(^(0),"^",3)=$P(^(0),"^",3)+COST

 Q

RECALC ;

 D NEW S:'$D(^PSI(58.5,PSGWADT,"S",SITE,"DRG",0)) ^(0)="^58.52P^^"

 I '$D(^PSI(58.5,"D",PSGWDN,PSGWADT,SITE)) S DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""DRG"",",DIC(0)="LM",X=PSGWDN,DA(2)=PSGWADT,DA(1)=SITE,DIC("DR")="2///"_INC K DD,DO D FILE^DICN K DIC

 S DRGDA=$O(^PSI(58.5,"D",PSGWDN,PSGWADT,SITE,0)) I '$D(^PSI(58.5,PSGWADT,"S",SITE,"DRG",DRGDA,"CAT",0)) S ^(0)="^58.53SA^^"

 S GOTIT=0 F CAT=0:0 S CAT=$O(^PSI(58.5,PSGWADT,"S",SITE,"DRG",DRGDA,"CAT",CAT)) Q:'CAT  I $P(^(CAT,0),"^")=PSGWCAT S $P(^(0),"^",2)=$P(^(0),"^",2)+PSGWQD S GOTIT=1 Q

 I GOTIT Q

 S DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""DRG"","_DRGDA_",""CAT"",",DIC(0)="LM",X=PSGWCAT,DA(3)=PSGWADT,DA(2)=SITE,DA(1)=DRGDA,DIC("DR")="1///"_PSGWQD K DD,DO D FILE^DICN K DIC Q

SETRET ;

 D NEW S:'$D(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",0)) ^(0)="^58.51S^^"

 I '$D(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD)) S DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""AMIS"",",DIC(0)="LM",X=FLD,DA(2)=PSGWADT,DA(1)=SITE,DIC("DR")="3///"_DOSE_";4///"_COST K DD,DO D FILE^DICN K DIC Q

 S FLDA=$O(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD,0)),$P(^(0),"^",4)=$P(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",FLDA,0),"^",4)+DOSE,$P(^(0),"^",5)=$P(^(0),"^",5)+COST

 Q

NEW ;

 I '$D(^PSI(58.5,"B",PSGWADT)) S DIC="^PSI(58.5,",DIC(0)="LM",DLAYGO=58.5,(DINUM,X)=PSGWADT K DD,DO D FILE^DICN K DIC,DLAYGO

 S:'$D(^PSI(58.5,PSGWADT,"S",0)) ^(0)="^58.501PA^^" I '$D(^PSI(58.5,PSGWADT,"S",SITE,0)) S DIC="^PSI(58.5,"_PSGWADT_",""S"",",DIC(0)="LM",(DINUM,X)=SITE,DA(1)=PSGWADT K DD,DO D FILE^DICN K DIC

 Q

PSGWCAD   ;BHAM ISC/PTD,CML-Calculate and Store AMIS Data ; 29 Dec 93 / 9:13 AM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 +2       ;Calling routine passes these variables: PSGWADT -AMIS Date, PSGWDN -drug number, PSGWQD -quantity dispensed, PSGWCAT -AMIS category, PSGWAOU -AOU for returns, SITE -for INPATIENT SITE for AOU.

 +3       ;IF COMPLETE DATA IS NOT AVAILABLE, SET MISSING DATA FLAG. DO RECALC.

CHKDTA     SET INC=0

           IF PSGWCAT="R"

               IF '$DATA(^PSI(58.1,PSGWAOU,0))

                   WRITE !!,"Data missing - contact ADP personnel.",!,"The zero node for this AOU is missing.",!!,"No AMIS update made for this return!"

                   GOTO END

 +1        IF PSGWCAT="R"

               SET LOC3=^PSI(58.1,PSGWAOU,0)

               SET PSGWCAT=PSGWCAT_$SELECT($PIECE(LOC3,"^",2)="W":"W",1:"A")

 +2        IF $DATA(^PSDRUG(PSGWDN,660))

               SET LOC1=^(660)

 +3       IF '$TEST

               SET INC=1

               DO RECALC

               GOTO END

 +4        IF $DATA(^PSDRUG(PSGWDN,"PSG"))

               SET LOC2=^("PSG")

 +5       IF '$TEST

               SET INC=1

               DO RECALC

               GOTO END

 +6        FOR J=3,5,6

               IF $PIECE(LOC1,"^",J)=""

                   SET INC=1

                   DO RECALC

                   GOTO END

 +7        FOR J=2,3

               IF $PIECE(LOC2,"^",J)=""

                   SET INC=1

                   DO RECALC

                   GOTO END

 +8       ;

MAIN       DO CALC

           IF PSGWCAT["R"

               DO SETRET

               DO RECALC

               GOTO END

 +1        DO SETDSP

           DO RECALC

END        KILL INC,LOC1,LOC2,LOC3,J,DOSE,COST,FLD,CAT,DTDA,DRGDA,FLDA,DA,DR,GOTIT

           SET PSGWCAT=$EXTRACT(PSGWCAT)

 +1        QUIT 

 +2       ;

CALC      ;COMPLETE DATA IS AVAILABLE, SO CALCULATE AMIS DATA.

 +1        SET DOSE=PSGWQD*$PIECE(LOC2,"^",3)

           SET COST=PSGWQD*$PIECE(LOC1,"^",6)

 +2        IF PSGWCAT="A"

               SET FLD=$SELECT($PIECE(LOC2,"^",2)=0:"04",$PIECE(LOC2,"^",2)=1:"07",$PIECE(LOC2,"^",2)=2:"17",1:"22")

 +3        IF PSGWCAT="W"

               SET FLD=$SELECT($PIECE(LOC2,"^",2)=0:"03",$PIECE(LOC2,"^",2)=1:"06",$PIECE(LOC2,"^",2)=2:"17",1:"22")

 +4        IF PSGWCAT["R"

               SET FLD=$SELECT($PIECE(LOC3,"^",2)="W":$SELECT($PIECE(LOC2,"^",2)=0:"03",$PIECE(LOC2,"^",2)=1:"06",$PIECE(LOC2,"^",2)=2:"17",1:"22"),1:$SELECT($PIECE(LOC2,"^",2)=0:"04",$PIECE(LOC2,"^",2)=1:"07",$PIECE(LOC2,"^",2)=2:"17",1:"22"))

 +5        QUIT 

 +6       ;

SETDSP    ;

 +1        DO NEW

           IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",0))

               SET ^(0)="^58.51S^^"

 +2        IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD))

               SET DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""AMIS"","

               SET DIC(0)="LM"

               SET X=FLD

               SET DA(2)=PSGWADT

               SET DA(1)=SITE

               SET DIC("DR")="1///"_DOSE_";2///"_COST

               KILL DD,DO

               DO FILE^DICN

               KILL DIC

               QUIT 

 +3        SET FLDA=$ORDER(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD,0))

           SET $PIECE(^(0),"^",2)=$PIECE(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",FLDA,0),"^",2)+DOSE

           SET $PIECE(^(0),"^",3)=$PIECE(^(0),"^",3)+COST

 +4        QUIT 

RECALC    ;

 +1        DO NEW

           IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"DRG",0))

               SET ^(0)="^58.52P^^"

 +2        IF '$DATA(^PSI(58.5,"D",PSGWDN,PSGWADT,SITE))

               SET DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""DRG"","

               SET DIC(0)="LM"

               SET X=PSGWDN

               SET DA(2)=PSGWADT

               SET DA(1)=SITE

               SET DIC("DR")="2///"_INC

               KILL DD,DO

               DO FILE^DICN

               KILL DIC

 +3        SET DRGDA=$ORDER(^PSI(58.5,"D",PSGWDN,PSGWADT,SITE,0))

           IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"DRG",DRGDA,"CAT",0))

               SET ^(0)="^58.53SA^^"

 +4        SET GOTIT=0

           FOR CAT=0:0

               SET CAT=$ORDER(^PSI(58.5,PSGWADT,"S",SITE,"DRG",DRGDA,"CAT",CAT))

               IF 'CAT

                   QUIT 

               IF $PIECE(^(CAT,0),"^")=PSGWCAT

                   SET $PIECE(^(0),"^",2)=$PIECE(^(0),"^",2)+PSGWQD

                   SET GOTIT=1

                   QUIT 

 +5        IF GOTIT

               QUIT 

 +6        SET DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""DRG"","_DRGDA_",""CAT"","

           SET DIC(0)="LM"

           SET X=PSGWCAT

           SET DA(3)=PSGWADT

           SET DA(2)=SITE

           SET DA(1)=DRGDA

           SET DIC("DR")="1///"_PSGWQD

           KILL DD,DO

           DO FILE^DICN

           KILL DIC

           QUIT 

SETRET    ;

 +1        DO NEW

           IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",0))

               SET ^(0)="^58.51S^^"

 +2        IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD))

               SET DIC="^PSI(58.5,"_PSGWADT_",""S"","_SITE_",""AMIS"","

               SET DIC(0)="LM"

               SET X=FLD

               SET DA(2)=PSGWADT

               SET DA(1)=SITE

               SET DIC("DR")="3///"_DOSE_";4///"_COST

               KILL DD,DO

               DO FILE^DICN

               KILL DIC

               QUIT 

 +3        SET FLDA=$ORDER(^PSI(58.5,PSGWADT,"S",SITE,"AMIS","FLD",FLD,0))

           SET $PIECE(^(0),"^",4)=$PIECE(^PSI(58.5,PSGWADT,"S",SITE,"AMIS",FLDA,0),"^",4)+DOSE

           SET $PIECE(^(0),"^",5)=$PIECE(^(0),"^",5)+COST

 +4        QUIT 

NEW       ;

 +1        IF '$DATA(^PSI(58.5,"B",PSGWADT))

               SET DIC="^PSI(58.5,"

               SET DIC(0)="LM"

               SET DLAYGO=58.5

               SET (DINUM,X)=PSGWADT

               KILL DD,DO

               DO FILE^DICN

               KILL DIC,DLAYGO

 +2        IF '$DATA(^PSI(58.5,PSGWADT,"S",0))

               SET ^(0)="^58.501PA^^"

           IF '$DATA(^PSI(58.5,PSGWADT,"S",SITE,0))

               SET DIC="^PSI(58.5,"_PSGWADT_",""S"","

               SET DIC(0)="LM"

               SET (DINUM,X)=SITE

               SET DA(1)=PSGWADT

               KILL DD,DO

               DO FILE^DICN

               KILL DIC

 +3        QUIT