PSGWCL.m

PSGWCL ;BHAM ISC/PTD,CML-Clear AMIS Exceptions ; 29 Dec 93 / 2:29 PM

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

 W !!,"This option will show AR/WS drugs for which information is missing.",!,"The information MUST be supplied before the AMIS report can be printed.",!!

 ;GET DATES FOR AMIS REPORT

BDT S %DT="AEX",%DT("A")="BEGINNING date for AMIS report: " D ^%DT K %DT G:Y<0 END S BDT=Y

EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for AMIS report: " D ^%DT K %DT G:Y<0 END S EDT=Y

 I '$O(^PSI(58.5,"AEX",BDT-1)) W !!,"No AMIS exceptions for selected dates." G END

 S QUEFLG=0 D ^PSGWCLP G:QUEFLG END

CONT W !!,"Do you wish to edit incomplete data now" S %=1 D YN^DICN I %<0!(%=2) G END

 I '% W !?5,"Enter ""YES"" or ""NO""" G CONT

 ;LOOP THROUGH THE "AEX" CROSS-REFERENCE

 S DATDA=(BDT-1),(SITE,DRGDA,INC,MSG)=0

DTLP S DATDA=$O(^PSI(58.5,"AEX",DATDA)),PSGWADT=$P(DATDA,".") G:(DATDA>EDT)!(DATDA="") MSG

STLP S SITE=$O(^PSI(58.5,"AEX",DATDA,SITE)) G:'SITE DTLP

DRGLP S DRGDA=$O(^PSI(58.5,"AEX",DATDA,SITE,DRGDA)) G:'DRGDA STLP

ASK ;ASK FOR MISSING DRUG DATA

 S PSGWDN=$P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^"),DRGNAM=$S($P($G(^PSDRUG(PSGWDN,0)),"^")'="":$P(^(0),"^"),1:"") I DRGNAM="" W !!,"The name for drug ",PSGWDN," is missing from the drug file.",!,"Notify your package coordinator!" G DRGLP

 I $D(LOC(PSGWDN)) D CHK G DRGLP

 W !!,"==> Information incomplete for: ",DRGNAM,!

 S INC=1,DIE="^PSDRUG(",DA=PSGWDN,DR="13;15;301;302" D ^DIE K DIE G:$D(Y) MSG S LOC(PSGWDN)="" D CHK G DRGLP

CHK ;VERIFY THAT USER HAS ENTERED ALL NECESSARY DATA

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

 E  S INC=1,MSG=1 Q

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

 E  S INC=1,MSG=1 Q

 F J=3,5,6 I $P(LOC1,"^",J)="" S INC=1,MSG=1 Q

 F J=2,3 I $P(LOC2,"^",J)="" S INC=1,MSG=1 Q

 I INC=0 D UPAMIS

 Q

MSG I INC!(MSG) W *7,!!,"DATA IS STILL MISSING!  YOU WILL NOT BE ABLE",!,"TO PRINT AMIS UNTIL INFORMATION IS COMPLETE!!"

 E  W !!,"DATA COMPLETE!!"

END K PSGWCAT,PSGWQD,X,Y,BDT,EDT,SITE,DATDA,DRGDA,DRGNAM,LOC1,LOC2,INC,J,PSGWDN,CAT,COST,DOSE,FLD,FLDA,LOC,LOC3,PSGWADT,PSGWAOU,DA,DR,%,D0,DI,DIG,DIH,DIU,DIV,DQ,DTDA,QUEFLG,G,MSG Q

 ;

UPAMIS ;UPDATE THE AMIS SUBFILE AND REMOVE INCOMPLETE FLAG & X-REF

 I '$O(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",0)) D KILL Q

 F CAT=0:0 S CAT=$O(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT)) Q:'CAT  S PSGWCAT=$P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT,0),"^"),PSGWQD=$P(^(0),"^",2) D UPDATE

 Q

 ;

UPDATE I PSGWCAT["R" S LOC3="^"_$E(PSGWCAT,2)

 D CALC^PSGWCAD

AMIS D @($S(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))

KILL S $P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^",2)=0

 K ^PSI(58.5,"AEX",DATDA,SITE,DRGDA)

 K PSGWCAT,PSGWQD,LOC3,DOSE,COST,FLD

 Q

PSGWCL    ;BHAM ISC/PTD,CML-Clear AMIS Exceptions ; 29 Dec 93 / 2:29 PM

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

 +2        WRITE !!,"This option will show AR/WS drugs for which information is missing.",!,"The information MUST be supplied before the AMIS report can be printed.",!!

 +3       ;GET DATES FOR AMIS REPORT

BDT        SET %DT="AEX"

           SET %DT("A")="BEGINNING date for AMIS report: "

           DO ^%DT

           KILL %DT

           IF Y<0

               GOTO END

           SET BDT=Y

EDT        SET %DT="AEX"

           SET %DT(0)=BDT

           SET %DT("A")="ENDING date for AMIS report: "

           DO ^%DT

           KILL %DT

           IF Y<0

               GOTO END

           SET EDT=Y

 +1        IF '$ORDER(^PSI(58.5,"AEX",BDT-1))

               WRITE !!,"No AMIS exceptions for selected dates."

               GOTO END

 +2        SET QUEFLG=0

           DO ^PSGWCLP

           IF QUEFLG

               GOTO END

CONT       WRITE !!,"Do you wish to edit incomplete data now"

           SET %=1

           DO YN^DICN

           IF %<0!(%=2)

               GOTO END

 +1        IF '%

               WRITE !?5,"Enter ""YES"" or ""NO"""

               GOTO CONT

 +2       ;LOOP THROUGH THE "AEX" CROSS-REFERENCE

 +3        SET DATDA=(BDT-1)

           SET (SITE,DRGDA,INC,MSG)=0

DTLP       SET DATDA=$ORDER(^PSI(58.5,"AEX",DATDA))

           SET PSGWADT=$PIECE(DATDA,".")

           IF (DATDA>EDT)!(DATDA="")

               GOTO MSG

STLP       SET SITE=$ORDER(^PSI(58.5,"AEX",DATDA,SITE))

           IF 'SITE

               GOTO DTLP

DRGLP      SET DRGDA=$ORDER(^PSI(58.5,"AEX",DATDA,SITE,DRGDA))

           IF 'DRGDA

               GOTO STLP

ASK       ;ASK FOR MISSING DRUG DATA

 +1        SET PSGWDN=$PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^")

           SET DRGNAM=$SELECT($PIECE($GET(^PSDRUG(PSGWDN,0)),"^")'="":$PIECE(^(0),"^"),1:"")

           IF DRGNAM=""

               WRITE !!,"The name for drug ",PSGWDN," is missing from the drug file.",!,"Notify your package coordinator!"

               GOTO DRGLP

 +2        IF $DATA(LOC(PSGWDN))

               DO CHK

               GOTO DRGLP

 +3        WRITE !!,"==> Information incomplete for: ",DRGNAM,!

 +4        SET INC=1

           SET DIE="^PSDRUG("

           SET DA=PSGWDN

           SET DR="13;15;301;302"

           DO ^DIE

           KILL DIE

           IF $DATA(Y)

               GOTO MSG

           SET LOC(PSGWDN)=""

           DO CHK

           GOTO DRGLP

CHK       ;VERIFY THAT USER HAS ENTERED ALL NECESSARY DATA

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

               SET LOC1=^(660)

               SET INC=0

 +2       IF '$TEST

               SET INC=1

               SET MSG=1

               QUIT 

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

               SET LOC2=^("PSG")

               SET INC=0

 +4       IF '$TEST

               SET INC=1

               SET MSG=1

               QUIT 

 +5        FOR J=3,5,6

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

                   SET INC=1

                   SET MSG=1

                   QUIT 

 +6        FOR J=2,3

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

                   SET INC=1

                   SET MSG=1

                   QUIT 

 +7        IF INC=0

               DO UPAMIS

 +8        QUIT 

MSG        IF INC!(MSG)

               WRITE *7,!!,"DATA IS STILL MISSING!  YOU WILL NOT BE ABLE",!,"TO PRINT AMIS UNTIL INFORMATION IS COMPLETE!!"

 +1       IF '$TEST

               WRITE !!,"DATA COMPLETE!!"

END        KILL PSGWCAT,PSGWQD,X,Y,BDT,EDT,SITE,DATDA,DRGDA,DRGNAM,LOC1,LOC2,INC,J,PSGWDN,CAT,COST,DOSE,FLD,FLDA,LOC,LOC3,PSGWADT,PSGWAOU,DA,DR,%,D0,DI,DIG,DIH,DIU,DIV,DQ,DTDA,QUEFLG,G,MSG

           QUIT 

 +1       ;

UPAMIS    ;UPDATE THE AMIS SUBFILE AND REMOVE INCOMPLETE FLAG & X-REF

 +1        IF '$ORDER(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",0))

               DO KILL

               QUIT 

 +2        FOR CAT=0:0

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

               IF 'CAT

                   QUIT 

               SET PSGWCAT=$PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT,0),"^")

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

               DO UPDATE

 +3        QUIT 

 +4       ;

UPDATE     IF PSGWCAT["R"

               SET LOC3="^"_$EXTRACT(PSGWCAT,2)

 +1        DO CALC^PSGWCAD

AMIS       DO @($SELECT(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))

KILL       SET $PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^",2)=0

 +1        KILL ^PSI(58.5,"AEX",DATDA,SITE,DRGDA)

 +2        KILL PSGWCAT,PSGWQD,LOC3,DOSE,COST,FLD

 +3        QUIT