- PSSFIL ;BIR/CML3-SON OF VARIOUS FILES' UPKEEP ; 09/15/97 13:21
- ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
- ;
- ENDTE ; default team edit
- I '$O(^PS(57.7,DA,1,0)) W !!,"NO TEAMS ENTERED TO CHOOSE FROM!" K X Q
- N DIC,DIE S DIC="^PS(57.7,"_DA_",1,",DIC(0)="EQM" D ^DIC I Y'>0 K X Q
- S X=+Y Q
- ;
- ENOAOPT ; order action on patient transfer
- D ENSWT I %<0 K % Q
- K DA,DR S DA=1,DIE="^PS(59.7,",DR="[PSJ OAOPT]" D ^DIE
- S X="PSGSETU" X ^%ZOSF("TEST") I D ENCV^PSGSETU Q
- ;
- ENSWT ; set-up discontinue on all ward transfers
- S X="PSGFILD1" X ^%ZOSF("TEST") I F W !!,"Do you want the instructions for auto-discontinue set-up" S %=1 D YN^DICN Q:% D
- .W !!?2,"Enter ""YES"" to view the instructions for the auto-discontinue set-up. Enter",!,"""NO"" to bypass the instructions. Enter ""^"" to abort the set-up."
- Q:%<0 D:%=1 ENWAI^PSGFILD1
- F W !!,"Do you want the package to set-up all of your wards for auto-discontinue" S %=2 D YN^DICN Q:% D SWTH
- Q:%'=1 W !!?3,"Working..." K PSGW S PSGW=0 F Q=0:0 S Q=$O(^DIC(42,Q)) Q:'Q I $D(^(Q,0)) S X=$P(^(0),"^"),PSGW(Q)=$S(X]"":X,1:Q_";DIC(42,"),PSGW=PSGW+1
- I '$D(^PS(59.7,1,22,0)) S ^(0)="^59.722P"
- F PSGX=0:0 S PSGX=$O(PSGW(PSGX)) Q:'PSGX W !,PSGW(PSGX),"..." D:'$D(^PS(59.7,1,22,PSGX)) SW F PSGY=0:0 S PSGY=$O(PSGW(PSGY)) Q:'PSGY I PSGX'=PSGY,'$D(^PS(59.7,1,22,PSGX,1,PSGY,0)) D SW1
- K PSGW,PSGX,PSGY S %=0 Q
- ;
- SW ;
- W "." K DIC,DA,DD,DO S DIC="^PS(59.7,1,22,",DIC(0)="L",DA(1)=1,(DINUM,X)=PSGX D FILE^DICN S:'$D(^PS(59.7,1,22,PSGX,1,0)) ^(0)="^59.7221P" Q
- ;
- SW1 ;
- W "." K DIC,DA,DD,DO S DIC="^PS(59.7,1,22,"_PSGX_",1,",DIC(0)="L",DA(2)=1,DA(1)=PSGX,(DINUM,X)=PSGY D FILE^DICN Q
- ;
- SWTH ;
- W !?2,"Enter ""YES"" to have the package set-up all of your wards for auto-discontinue",!,"for you. Enter ""NO"" if you prefer to set-up the wards individually. Enter ""^""",!,"to abort the set-up."
- W !!?2,"If you answer YES, you will still be able to add, edit and delete individual",!,"wards.",!!?2,"PLEASE NOTE that this is not a flag for the package, but a one-time action.",!,"If you add new wards to your WARD LOCATION file, you will"
- W " need to add those",!,"wards here." Q
- ;
- ENSUEP ; supervisor edit of user parameters
- F K DIC S DIC="^PS(53.45,",DIC(0)="AELQZ",DIC("A")="Select INPATIENT USER: ",DLAYGO=53.45 W ! D ^DIC K DIC,DLAYGO Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(53.45,",DR="[PSJ IUP SUPER EDIT]",IU=+Y(0) D W ! D ^DIE
- .F X=1:1:3 I $D(^XUSEC("PSJ "_$P("RPHARM^RNURSE^PHARM TECH","^",X),IU)) Q
- .S:'$T X=0 S R=$G(^VA(200,IU,"PS")),R=$S('R:0,'$P(R,"^",4):1,1:$P(R,"^",4)>DT)
- .W !!,"This user is a " W:X $P("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X) W:'X&'R "WARD CLERK" W:'R "." I R W:X " and a " W "PROVIDER."
- K IU,PSJ,R S X="PSGSETU" X ^%ZOSF("TEST") I D ENKV^PSGSETU W !!,"PLEASE NOTE: Any changes made will not take effect for the corresponding users",!,"until those users completely exit and re-enter the system." Q
- ;
- ENUUEP ;
- S X="PSGSETU" X ^%ZOSF("TEST") I D ENCV^PSGSETU K DA,DR S DA=PSJSYSP,DIE="^PS(53.45,",DR="[PSJ IUP USER EDIT]" D W ! D ^DIE K ^XUTL("OR",$J,"PSG") D ENKV^PSGSETU
- .F X=1:1:3 I $D(^XUSEC("PSJ "_$P("RPHARM^RNURSE^PHARM TECH","^",X),DUZ)) Q
- .S:'$T X=0 S R=$G(^VA(200,DUZ,"PS")),R=$S('R:0,'$P(R,"^",4):1,1:$P(R,"^",4)>DT)
- .W !!,"You are a " W:X $P("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X) W:'X&'R "WARD CLERK" W:'R "." I R W:X " and a " W "PROVIDER."
- W !!,"PLEASE NOTE: Any changes made take effect immediately." Q
- ;
- ENIWPE ; edit inpatient ward parameters
- F K DIC S DIC="^PS(59.6,",DIC(0)="AELMQ",DIC("A")="Select WARD: ",DLAYGO=59.6 W ! D ^DIC K DIC Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(59.6,",DR="[PSJ IWP EDIT]" W ! D ^DIE
- K ^TMP("OR",$J,"PSG") S X="PSGSETU" X ^%ZOSF("TEST") I D ENKV^PSGSETU Q
- ;
- ENPDE ; edit primary drug
- F K DIC S DIC="^PS(50.3,",DIC(0)="AELMQ",DIC("A")="Select PRIMARY DRUG: ",DLAYGO=50.3 W ! D ^DIC K DIC Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(50.3,",DR="[PSS PD EDIT]" D ^DIE
- K DA,DIC,DIE,DLAYGO,DR,X,Y,PSGS0XT,PSGS0Y Q
- ;
- ENALU ; application look-up
- N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)=$E("E",'$D(PSJPRE4))_"IMZ" D DO^DIC1,^DIC I Y'>0 K X Q
- S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X Q
- ;
- ENAQ ; application query
- S X=DZ N DA,DIC,DIE,DO,DR,DZ S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSFIL 4337 printed Feb 18, 2025@23:57:36 Page 2
- PSSFIL ;BIR/CML3-SON OF VARIOUS FILES' UPKEEP ; 09/15/97 13:21
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
- +2 ;
- ENDTE ; default team edit
- +1 IF '$ORDER(^PS(57.7,DA,1,0))
- WRITE !!,"NO TEAMS ENTERED TO CHOOSE FROM!"
- KILL X
- QUIT
- +2 NEW DIC,DIE
- SET DIC="^PS(57.7,"_DA_",1,"
- SET DIC(0)="EQM"
- DO ^DIC
- IF Y'>0
- KILL X
- QUIT
- +3 SET X=+Y
- QUIT
- +4 ;
- ENOAOPT ; order action on patient transfer
- +1 DO ENSWT
- IF %<0
- KILL %
- QUIT
- +2 KILL DA,DR
- SET DA=1
- SET DIE="^PS(59.7,"
- SET DR="[PSJ OAOPT]"
- DO ^DIE
- +3 SET X="PSGSETU"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ENCV^PSGSETU
- QUIT
- +4 ;
- ENSWT ; set-up discontinue on all ward transfers
- +1 SET X="PSGFILD1"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- FOR
- WRITE !!,"Do you want the instructions for auto-discontinue set-up"
- SET %=1
- DO YN^DICN
- if %
- QUIT
- Begin DoDot:1
- +2 WRITE !!?2,"Enter ""YES"" to view the instructions for the auto-discontinue set-up. Enter",!,"""NO"" to bypass the instructions. Enter ""^"" to abort the set-up."
- End DoDot:1
- +3 if %<0
- QUIT
- if %=1
- DO ENWAI^PSGFILD1
- +4 FOR
- WRITE !!,"Do you want the package to set-up all of your wards for auto-discontinue"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- DO SWTH
- +5 if %'=1
- QUIT
- WRITE !!?3,"Working..."
- KILL PSGW
- SET PSGW=0
- FOR Q=0:0
- SET Q=$ORDER(^DIC(42,Q))
- if 'Q
- QUIT
- IF $DATA(^(Q,0))
- SET X=$PIECE(^(0),"^")
- SET PSGW(Q)=$SELECT(X]"":X,1:Q_";DIC(42,")
- SET PSGW=PSGW+1
- +6 IF '$DATA(^PS(59.7,1,22,0))
- SET ^(0)="^59.722P"
- +7 FOR PSGX=0:0
- SET PSGX=$ORDER(PSGW(PSGX))
- if 'PSGX
- QUIT
- WRITE !,PSGW(PSGX),"..."
- if '$DATA(^PS(59.7,1,22,PSGX))
- DO SW
- FOR PSGY=0:0
- SET PSGY=$ORDER(PSGW(PSGY))
- if 'PSGY
- QUIT
- IF PSGX'=PSGY
- IF '$DATA(^PS(59.7,1,22,PSGX,1,PSGY,0))
- DO SW1
- +8 KILL PSGW,PSGX,PSGY
- SET %=0
- QUIT
- +9 ;
- SW ;
- +1 WRITE "."
- KILL DIC,DA,DD,DO
- SET DIC="^PS(59.7,1,22,"
- SET DIC(0)="L"
- SET DA(1)=1
- SET (DINUM,X)=PSGX
- DO FILE^DICN
- if '$DATA(^PS(59.7,1,22,PSGX,1,0))
- SET ^(0)="^59.7221P"
- QUIT
- +2 ;
- SW1 ;
- +1 WRITE "."
- KILL DIC,DA,DD,DO
- SET DIC="^PS(59.7,1,22,"_PSGX_",1,"
- SET DIC(0)="L"
- SET DA(2)=1
- SET DA(1)=PSGX
- SET (DINUM,X)=PSGY
- DO FILE^DICN
- QUIT
- +2 ;
- SWTH ;
- +1 WRITE !?2,"Enter ""YES"" to have the package set-up all of your wards for auto-discontinue",!,"for you. Enter ""NO"" if you prefer to set-up the wards individually. Enter ""^""",!,"to abort the set-up."
- +2 WRITE !!?2,"If you answer YES, you will still be able to add, edit and delete individual",!,"wards.",!!?2,"PLEASE NOTE that this is not a flag for the package, but a one-time action.",!,"If you add new wards to your WARD LOCATION file, you will
- "
- +3 WRITE " need to add those",!,"wards here."
- QUIT
- +4 ;
- ENSUEP ; supervisor edit of user parameters
- +1 FOR
- KILL DIC
- SET DIC="^PS(53.45,"
- SET DIC(0)="AELQZ"
- SET DIC("A")="Select INPATIENT USER: "
- SET DLAYGO=53.45
- WRITE !
- DO ^DIC
- KILL DIC,DLAYGO
- if Y'>0
- QUIT
- KILL DA,DR
- SET DA=+Y
- SET DIE="^PS(53.45,"
- SET DR="[PSJ IUP SUPER EDIT]"
- SET IU=+Y(0)
- Begin DoDot:1
- +2 FOR X=1:1:3
- IF $DATA(^XUSEC("PSJ "_$PIECE("RPHARM^RNURSE^PHARM TECH","^",X),IU))
- QUIT
- +3 if '$TEST
- SET X=0
- SET R=$GET(^VA(200,IU,"PS"))
- SET R=$SELECT('R:0,'$PIECE(R,"^",4):1,1:$PIECE(R,"^",4)>DT)
- +4 WRITE !!,"This user is a "
- if X
- WRITE $PIECE("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X)
- if 'X&'R
- WRITE "WARD CLERK"
- if 'R
- WRITE "."
- IF R
- if X
- WRITE " and a "
- WRITE "PROVIDER."
- End DoDot:1
- WRITE !
- DO ^DIE
- +5 KILL IU,PSJ,R
- SET X="PSGSETU"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ENKV^PSGSETU
- WRITE !!,"PLEASE NOTE: Any changes made will not take effect for the corresponding users",!,"until those users completely exit and re-enter the system."
- QUIT
- +6 ;
- ENUUEP ;
- +1 SET X="PSGSETU"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ENCV^PSGSETU
- KILL DA,DR
- SET DA=PSJSYSP
- SET DIE="^PS(53.45,"
- SET DR="[PSJ IUP USER EDIT]"
- Begin DoDot:1
- +2 FOR X=1:1:3
- IF $DATA(^XUSEC("PSJ "_$PIECE("RPHARM^RNURSE^PHARM TECH","^",X),DUZ))
- QUIT
- +3 if '$TEST
- SET X=0
- SET R=$GET(^VA(200,DUZ,"PS"))
- SET R=$SELECT('R:0,'$PIECE(R,"^",4):1,1:$PIECE(R,"^",4)>DT)
- +4 WRITE !!,"You are a "
- if X
- WRITE $PIECE("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X)
- if 'X&'R
- WRITE "WARD CLERK"
- if 'R
- WRITE "."
- IF R
- if X
- WRITE " and a "
- WRITE "PROVIDER."
- End DoDot:1
- WRITE !
- DO ^DIE
- KILL ^XUTL("OR",$JOB,"PSG")
- DO ENKV^PSGSETU
- +5 WRITE !!,"PLEASE NOTE: Any changes made take effect immediately."
- QUIT
- +6 ;
- ENIWPE ; edit inpatient ward parameters
- +1 FOR
- KILL DIC
- SET DIC="^PS(59.6,"
- SET DIC(0)="AELMQ"
- SET DIC("A")="Select WARD: "
- SET DLAYGO=59.6
- WRITE !
- DO ^DIC
- KILL DIC
- if Y'>0
- QUIT
- KILL DA,DR
- SET DA=+Y
- SET DIE="^PS(59.6,"
- SET DR="[PSJ IWP EDIT]"
- WRITE !
- DO ^DIE
- +2 KILL ^TMP("OR",$JOB,"PSG")
- SET X="PSGSETU"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ENKV^PSGSETU
- QUIT
- +3 ;
- ENPDE ; edit primary drug
- +1 FOR
- KILL DIC
- SET DIC="^PS(50.3,"
- SET DIC(0)="AELMQ"
- SET DIC("A")="Select PRIMARY DRUG: "
- SET DLAYGO=50.3
- WRITE !
- DO ^DIC
- KILL DIC
- if Y'>0
- QUIT
- KILL DA,DR
- SET DA=+Y
- SET DIE="^PS(50.3,"
- SET DR="[PSS PD EDIT]"
- DO ^DIE
- +2 KILL DA,DIC,DIE,DLAYGO,DR,X,Y,PSGS0XT,PSGS0Y
- QUIT
- +3 ;
- ENALU ; application look-up
- +1 NEW PSJ
- SET PSJ=DA(1)
- NEW DA,DIC,DIE,DIX,DO,DR
- SET DIC="^PS(50.35,"
- SET DIC(0)=$EXTRACT("E",'$DATA(PSJPRE4))_"IMZ"
- DO DO^DIC1
- DO ^DIC
- IF Y'>0
- KILL X
- QUIT
- +2 SET X=$PIECE(Y(0),"^",2)
- if $SELECT(X=""
- KILL X
- QUIT
- +3 ;
- ENAQ ; application query
- +1 SET X=DZ
- NEW DA,DIC,DIE,DO,DR,DZ
- SET DIC="^PS(50.35,"
- SET DIC(0)="EIMQ"
- DO DO^DIC1
- DO ^DIC
- QUIT