PSJPRE43.m

PSJPRE43 ; B'ham ISC/CML3 - MOVE PICK LIST PARAMETERS ;9/4/91  18:30

 ;;3.2;;**28**

 ;

 W @IOF,!?18,"MOVE PICK LIST PARAMETERS TO WARD GROUP FILE"

 W !!?2,"This option is designed to allow you to seed the Inpatient Ward Group file",!,"with the PICK LIST data from the Inpatient Site Parameter file.  After the ward",!,"group list is built, select the Inpatient site from which you want to"

 W " move the",!,"pick list data.  Then select the ward group(s) which you want to seed with the",!,"pick list data.  The pick list data from the selected Inpatient site will then",!,"be moved to each ward group selected."

 W !!,"BUILDING the ward group list..." D BWL

 I 'PSG F  W !!,"The data move has already been completed.",!,"Would you like to edit any of the entries in the Ward Group file" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."

 I 'PSG G:%=1 ENWE G DONE

 ;

IS ;

 K DIC S DIC="^PS(59.4,",DIC(0)="AEMQZ",DIC("S")="I $G(^(5))]""""" W ! D ^DIC I Y'>0 G DONE

 S IS=+Y,ISND=$G(^PS(59.4,IS,5))

 ;

 S DIR(0)="LAO^1:"_PSG,DIR("A")="Select WARD GROUP(S) (1-"_PSG_"): ",DIR("?")="^D WH^PSJPRE43" W ! D ^DIR G:'Y IS

 W !!,"Working..."

 F Q1=0:1 Q:'$D(Y(Q1))  F Q2=1:1 S X=$P(Y(Q1),",",Q2) Q:'X  S ^PS(57.5,+PSG(X),5)=ISND

 D BWL G:PSG IS F  W !!,"The data move has been completed to all wards.",!,"Would you like to edit any of the ward groups" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."

 G:%=1 ENWE G DONE

 W !,"Working..."

 ;

BWL ; build ward list

 K PSG S (PSG,Q)=0

 F  S Q=$O(^PS(57.5,Q)) Q:'Q  S X=$G(^(Q,0)) I $P(X,"^",2)="P",'$D(^(5)) S PSG=PSG+1,PSG(PSG)=Q_"^"_$P(X,"^")

 Q

 ;

WH ;

 W !!?2,"Select the ward group(s) to which you want to move the pick list data from",!,"the selected Inpatient site.  Choose, by number, from the following ward",!,"groups:"

 S Q=0 F  S Q=Q+1 Q:Q>PSG  W !,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?26,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?52,$J(Q,3),". ",$P(PSG(Q),"^",2)

 Q

 ;

ENWE ;

 F  S DIC="^PS(57.5,",DIC(0)="AEMQ",DIC("S")="I $P($G(^(0)),U,2)=""P""" W ! D ^DIC Q:Y'>0  S DA=+Y,DIE=DIC,DR="5.02;5.03;S:X Y=""@3"";5.01;@3;5.04;S:X Y=""@5"";5.05;@5;S %=$G(^PS(57.5,DA,5)) S:$S($P(%,U,4):1,1:'$P(%,U,5)) Y="""";5.06" W ! D ^DIE

 ;

DONE ;

 D ENKV^PSGSETU K IS,ISND,PSG,Q1,Q2 Q

PSJPRE43  ; B'ham ISC/CML3 - MOVE PICK LIST PARAMETERS ;9/4/91  18:30

 +1       ;;3.2;;**28**

 +2       ;

 +3        WRITE @IOF,!?18,"MOVE PICK LIST PARAMETERS TO WARD GROUP FILE"

 +4        WRITE !!?2,"This option is designed to allow you to seed the Inpatient Ward Group file",!,"with the PICK LIST data from the Inpatient Site Parameter file.  After the ward",!,"group list is built, select the Inpatient site from which you want to

"

 +5        WRITE " move the",!,"pick list data.  Then select the ward group(s) which you want to seed with the",!,"pick list data.  The pick list data from the selected Inpatient site will then",!,"be moved to each ward group selected."

 +6        WRITE !!,"BUILDING the ward group list..."

           DO BWL

 +7        IF 'PSG

               FOR 

                   WRITE !!,"The data move has already been completed.",!,"Would you like to edit any of the entries in the Ward Group file"

                   SET %=0

                   DO YN^DICN

                   IF %

                       QUIT 

                   WRITE !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."

 +8        IF 'PSG

               IF %=1

                   GOTO ENWE

               GOTO DONE

 +9       ;

IS        ;

 +1        KILL DIC

           SET DIC="^PS(59.4,"

           SET DIC(0)="AEMQZ"

           SET DIC("S")="I $G(^(5))]"""""

           WRITE !

           DO ^DIC

           IF Y'>0

               GOTO DONE

 +2        SET IS=+Y

           SET ISND=$GET(^PS(59.4,IS,5))

 +3       ;

 +4        SET DIR(0)="LAO^1:"_PSG

           SET DIR("A")="Select WARD GROUP(S) (1-"_PSG_"): "

           SET DIR("?")="^D WH^PSJPRE43"

           WRITE !

           DO ^DIR

           IF 'Y

               GOTO IS

 +5        WRITE !!,"Working..."

 +6        FOR Q1=0:1

               IF '$DATA(Y(Q1))

                   QUIT 

               FOR Q2=1:1

                   SET X=$PIECE(Y(Q1),",",Q2)

                   IF 'X

                       QUIT 

                   SET ^PS(57.5,+PSG(X),5)=ISND

 +7        DO BWL

           IF PSG

               GOTO IS

           FOR 

               WRITE !!,"The data move has been completed to all wards.",!,"Would you like to edit any of the ward groups"

               SET %=0

               DO YN^DICN

               IF %

                   QUIT 

               WRITE !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."

 +8        IF %=1

               GOTO ENWE

           GOTO DONE

 +9        WRITE !,"Working..."

 +10      ;

BWL       ; build ward list

 +1        KILL PSG

           SET (PSG,Q)=0

 +2        FOR 

               SET Q=$ORDER(^PS(57.5,Q))

               IF 'Q

                   QUIT 

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

               IF $PIECE(X,"^",2)="P"

                   IF '$DATA(^(5))

                       SET PSG=PSG+1

                       SET PSG(PSG)=Q_"^"_$PIECE(X,"^")

 +3        QUIT 

 +4       ;

WH        ;

 +1        WRITE !!?2,"Select the ward group(s) to which you want to move the pick list data from",!,"the selected Inpatient site.  Choose, by number, from the following ward",!,"groups:"

 +2        SET Q=0

           FOR 

               SET Q=Q+1

               IF Q>PSG

                   QUIT 

               WRITE !,$JUSTIFY(Q,3),". ",$PIECE(PSG(Q),"^",2)

               SET Q=Q+1

               IF Q>PSG

                   QUIT 

               WRITE ?26,$JUSTIFY(Q,3),". ",$PIECE(PSG(Q),"^",2)

               SET Q=Q+1

               IF Q>PSG

                   QUIT 

               WRITE ?52,$JUSTIFY(Q,3),". ",$PIECE(PSG(Q),"^",2)

 +3        QUIT 

 +4       ;

ENWE      ;

 +1        FOR 

               SET DIC="^PS(57.5,"

               SET DIC(0)="AEMQ"

               SET DIC("S")="I $P($G(^(0)),U,2)=""P"""

               WRITE !

               DO ^DIC

               IF Y'>0

                   QUIT 

               SET DA=+Y

               SET DIE=DIC

               SET DR="5.02;5.03;S:X Y=""@3"";5.01;@3;5.04;S:X Y=""@5"";5.05;@5;S %=$G(^PS(57.5,DA,5)) S:$S($P(%,U,4):1,1:'$P(%,U,5)) Y="""";5.06"

               WRITE !

               DO ^DIE

 +2       ;

DONE      ;

 +1        DO ENKV^PSGSETU

           KILL IS,ISND,PSG,Q1,Q2

           QUIT