PSGWSET.m

PSGWSET ;BHAM ISC/PTD,CML-Set Inpatient Site ; 08 Apr 93 / 1:34 PM

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

 K XQUIT,STDA,LOC I '$D(^PS(59.4,"B")) D NONE G END

COUNT S (CNT,LOC,STDA)=0 F J=0:0 S STDA=$O(^PS(59.4,STDA)) Q:'STDA  S:($P(^(STDA,0),"^",26)=1) LOC=LOC+1,LOC(+STDA)="" S CNT=CNT+1

 ;

SITE I LOC=1 S PSGWSITE=^PS(59.4,$O(LOC(0)),0) W !!,"AR/WS Inpatient Site Name: ",$P(^(0),"^")

 I 'LOC,CNT=1 S STDA=$O(^PS(59.4,0)),$P(^(STDA,0),"^",26)=1,PSGWSITE=^(0) W !!,"AR/WS Inpatient Site Name: ",$P(^(0),"^")

MULT I CNT>1,LOC'=1 S DIC="^PS(59.4,",DIC(0)="QEAMZ",DLAYGO=59.4,DIC("A")="Enter AR/WS Inpatient Site Name: " S:LOC>1 DIC("S")="I $P(^(0),U,26)=1" S:LOC=0 DIC(0)="QEAMLZ"

 I  D ^DIC K DIC,DLAYGO S:Y<0 XQUIT="" G:Y<0 END S $P(^PS(59.4,+Y,0),"^",26)=1,PSGWSITE=^PS(59.4,+Y,0)_"^M"

 ;

 I $D(PSGWSITE),$D(^PS(59.7,1,50)) D WARN

END K DIE,LOC,X,Y,STDA,CNT,J,UPDT,DA,DR Q

 ;

NONE S (DIC,DIE)="^PS(59.4,",DIC(0)="QEAMLZ",DLAYGO=59.4,DIC("A")="Enter AR/WS Inpatient Site Name: " D ^DIC K DIC,DLAYGO I Y<0 S XQUIT="" Q

 S (DA,STDA)=+Y,DR="5.5///"_1_";4;5" D ^DIE S PSGWSITE=^PS(59.4,STDA,0)

 Q

 ;

WARN Q:'^PS(59.7,1,50)

 S Y=^PS(59.7,1,50),UPDT=$P(Y,".") X ^DD("DD") S X1=DT,X2=$S($D(UPDT):UPDT,1:"") D ^%DTC

 I X>7 W *7,*7,!!?32,"*** WARNING ***",!!,$P(Y,"@")," was the last date that AR/WS AMIS Statistics were updated.",!

 I  W "Please contact ADP and request that Taskmanager option ""PSGW UPDATE AMIS STATS""",!,"be RESCHEDULED to run nightly.  AMIS will not be current until this option runs.",!!

 Q

 ;

PSGWSET   ;BHAM ISC/PTD,CML-Set Inpatient Site ; 08 Apr 93 / 1:34 PM

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

 +2        KILL XQUIT,STDA,LOC

           IF '$DATA(^PS(59.4,"B"))

               DO NONE

               GOTO END

COUNT      SET (CNT,LOC,STDA)=0

           FOR J=0:0

               SET STDA=$ORDER(^PS(59.4,STDA))

               IF 'STDA

                   QUIT 

               IF ($PIECE(^(STDA,0),"^",26)=1)

                   SET LOC=LOC+1

                   SET LOC(+STDA)=""

               SET CNT=CNT+1

 +1       ;

SITE       IF LOC=1

               SET PSGWSITE=^PS(59.4,$ORDER(LOC(0)),0)

               WRITE !!,"AR/WS Inpatient Site Name: ",$PIECE(^(0),"^")

 +1        IF 'LOC

               IF CNT=1

                   SET STDA=$ORDER(^PS(59.4,0))

                   SET $PIECE(^(STDA,0),"^",26)=1

                   SET PSGWSITE=^(0)

                   WRITE !!,"AR/WS Inpatient Site Name: ",$PIECE(^(0),"^")

MULT       IF CNT>1

               IF LOC'=1

                   SET DIC="^PS(59.4,"

                   SET DIC(0)="QEAMZ"

                   SET DLAYGO=59.4

                   SET DIC("A")="Enter AR/WS Inpatient Site Name: "

                   IF LOC>1

                       SET DIC("S")="I $P(^(0),U,26)=1"

                   IF LOC=0

                       SET DIC(0)="QEAMLZ"

 +1       IF $TEST

               DO ^DIC

               KILL DIC,DLAYGO

               IF Y<0

                   SET XQUIT=""

               IF Y<0

                   GOTO END

               SET $PIECE(^PS(59.4,+Y,0),"^",26)=1

               SET PSGWSITE=^PS(59.4,+Y,0)_"^M"

 +2       ;

 +3        IF $DATA(PSGWSITE)

               IF $DATA(^PS(59.7,1,50))

                   DO WARN

END        KILL DIE,LOC,X,Y,STDA,CNT,J,UPDT,DA,DR

           QUIT 

 +1       ;

NONE       SET (DIC,DIE)="^PS(59.4,"

           SET DIC(0)="QEAMLZ"

           SET DLAYGO=59.4

           SET DIC("A")="Enter AR/WS Inpatient Site Name: "

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               SET XQUIT=""

               QUIT 

 +1        SET (DA,STDA)=+Y

           SET DR="5.5///"_1_";4;5"

           DO ^DIE

           SET PSGWSITE=^PS(59.4,STDA,0)

 +2        QUIT 

 +3       ;

WARN       IF '^PS(59.7,1,50)

               QUIT 

 +1        SET Y=^PS(59.7,1,50)

           SET UPDT=$PIECE(Y,".")

           XECUTE ^DD("DD")

           SET X1=DT

           SET X2=$SELECT($DATA(UPDT):UPDT,1:"")

           DO ^%DTC

 +2        IF X>7

               WRITE *7,*7,!!?32,"*** WARNING ***",!!,$PIECE(Y,"@")," was the last date that AR/WS AMIS Statistics were updated.",!

 +3       IF $TEST

               WRITE "Please contact ADP and request that Taskmanager option ""PSGW UPDATE AMIS STATS""",!,"be RESCHEDULED to run nightly.  AMIS will not be current until this option runs.",!!

 +4        QUIT 

 +5       ;