- PSJPRE42 ; B'ham ISC/CML3 - MOVE SITE PARAMETERS ;2/18/92 16:56
- ;;3.2;;**28**
- ;
- W @IOF,!?18,"MOVE SITE PARAMETERS TO WARD PARAMETER FILE"
- W !!?2,"This option is designed to allow you to seed the Inpatient Ward Parameter file",!,"with data from the Inpatient Site Parameter file. After the ward list is built,",!,"select the Inpatient site from which you want to move data. Then"
- W " select the",!,"ward(s) which you want to seed with the site data. The data from the selected",!,"Inpatient site will then be moved to each ward selected.",!!,"BUILDING the ward 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 Parameter 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 ;
- S DIC="^PS(59.4,",DIC(0)="AEMQZ" W ! D ^DIC I Y'>0 G DONE
- S IS=+Y,ISND=Y(0) F Q=1,2,5,6,10,12,13,14,15,16,17,18,19,20,21,22,23,25,26,27,28,29,30 S $P(ISND,"^",Q)=""
- ;
- S DIR(0)="LAO^1:"_PSG,DIR("A")="Select WARD(S) (1-"_PSG_"): ",DIR("?")="^D WH^PSJPRE42" 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 D WS
- D BWL G:PSG IS F W !!,"The data move has been completed to all wards.",!,"Would you like to edit any of the wards" 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
- ;
- BWL ; build ward list
- K PSG S (PSG,Q)=0
- F S Q=$O(^DIC(42,Q)) Q:'Q I '$D(^PS(59.6,"B",Q)) S X=$G(^DIC(42,Q,0)),PSG=PSG+1,PSG(PSG)=Q_"^"_$P(X,"^")
- Q
- ;
- WH ;
- W !!?2,"Select the ward(s) to which you want to move the data from the selected",!,"Inpatient site. Choose, by number, from the following wards:"
- 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
- ;
- WS ;
- N Y S X=+PSG(X),$P(ISND,"^")=X,DIC="^PS(59.6,",DIC(0)="L",DLAYGO=59.6 W "." D ^DIC W "." I Y>0 S ^PS(59.6,+Y,0)=ISND,DA=+Y,DIK=DIC D IX1^DIK
- Q
- ;
- ENWE ;
- K DA,DIC,DIE,DR F S DIC="^PS(59.6,",DIC(0)="AEMQ" W ! D ^DIC Q:Y'>0 S DA=+Y,DIE=DIC,DR=".03;.04;.07;.08;.15;.12;.13;.16;.14;.11;.24" D ^DIE
- ;
- DONE ;
- D ENKV^PSGSETU K IS,ISND,PSG,Q1,Q2 Q
- ;
- ENDL ; device look-up
- N DA,DIC,DIE,DIX,DO,DR
- S DIC="^%ZIS(1,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q
- S X=Y(0,0) Q
- ;
- ENDH(X) ; device help
- N DA,DIC,DIE,DO,DR,DZ
- S DIC="^%ZIS(1,",DIC(0)="EIM" D DO^DIC1,^DIC Q
- PSJPRE42 ; B'ham ISC/CML3 - MOVE SITE PARAMETERS ;2/18/92 16:56
- +1 ;;3.2;;**28**
- +2 ;
- +3 WRITE @IOF,!?18,"MOVE SITE PARAMETERS TO WARD PARAMETER FILE"
- +4 WRITE !!?2,"This option is designed to allow you to seed the Inpatient Ward Parameter file",!,"with data from the Inpatient Site Parameter file. After the ward list is built,",!,"select the Inpatient site from which you want to move data. The
- n"
- +5 WRITE " select the",!,"ward(s) which you want to seed with the site data. The data from the selected",!,"Inpatient site will then be moved to each ward selected.",!!,"BUILDING the ward list..."
- +6 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 Parameter 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 SET DIC="^PS(59.4,"
- SET DIC(0)="AEMQZ"
- WRITE !
- DO ^DIC
- IF Y'>0
- GOTO DONE
- +2 SET IS=+Y
- SET ISND=Y(0)
- FOR Q=1,2,5,6,10,12,13,14,15,16,17,18,19,20,21,22,23,25,26,27,28,29,30
- SET $PIECE(ISND,"^",Q)=""
- +3 ;
- +4 SET DIR(0)="LAO^1:"_PSG
- SET DIR("A")="Select WARD(S) (1-"_PSG_"): "
- SET DIR("?")="^D WH^PSJPRE42"
- WRITE !
- DO ^DIR
- IF 'Y
- GOTO IS
- +5 WRITE !!,"Working..."
- FOR Q1=0:1
- IF '$DATA(Y(Q1))
- QUIT
- FOR Q2=1:1
- SET X=$PIECE(Y(Q1),",",Q2)
- IF 'X
- QUIT
- DO WS
- +6 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 wards"
- SET %=0
- DO YN^DICN
- IF %
- QUIT
- WRITE !!?2,"Enter 'YES' to edit the Ward Parameter file. Enter 'NO' to exit this option."
- +7 IF %=1
- GOTO ENWE
- GOTO DONE
- +8 ;
- BWL ; build ward list
- +1 KILL PSG
- SET (PSG,Q)=0
- +2 FOR
- SET Q=$ORDER(^DIC(42,Q))
- IF 'Q
- QUIT
- IF '$DATA(^PS(59.6,"B",Q))
- SET X=$GET(^DIC(42,Q,0))
- SET PSG=PSG+1
- SET PSG(PSG)=Q_"^"_$PIECE(X,"^")
- +3 QUIT
- +4 ;
- WH ;
- +1 WRITE !!?2,"Select the ward(s) to which you want to move the data from the selected",!,"Inpatient site. Choose, by number, from the following wards:"
- +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 ;
- WS ;
- +1 NEW Y
- SET X=+PSG(X)
- SET $PIECE(ISND,"^")=X
- SET DIC="^PS(59.6,"
- SET DIC(0)="L"
- SET DLAYGO=59.6
- WRITE "."
- DO ^DIC
- WRITE "."
- IF Y>0
- SET ^PS(59.6,+Y,0)=ISND
- SET DA=+Y
- SET DIK=DIC
- DO IX1^DIK
- +2 QUIT
- +3 ;
- ENWE ;
- +1 KILL DA,DIC,DIE,DR
- FOR
- SET DIC="^PS(59.6,"
- SET DIC(0)="AEMQ"
- WRITE !
- DO ^DIC
- IF Y'>0
- QUIT
- SET DA=+Y
- SET DIE=DIC
- SET DR=".03;.04;.07;.08;.15;.12;.13;.16;.14;.11;.24"
- DO ^DIE
- +2 ;
- DONE ;
- +1 DO ENKV^PSGSETU
- KILL IS,ISND,PSG,Q1,Q2
- QUIT
- +2 ;
- ENDL ; device look-up
- +1 NEW DA,DIC,DIE,DIX,DO,DR
- +2 SET DIC="^%ZIS(1,"
- SET DIC(0)="EIMZ"
- DO DO^DIC1
- DO ^DIC
- IF Y'>0
- KILL X
- QUIT
- +3 SET X=Y(0,0)
- QUIT
- +4 ;
- ENDH(X) ; device help
- +1 NEW DA,DIC,DIE,DO,DR,DZ
- +2 SET DIC="^%ZIS(1,"
- SET DIC(0)="EIM"
- DO DO^DIC1
- DO ^DIC
- QUIT
