PSJPRE4P ; B'ham ISC/CML3 - POST INIT ;2/11/92 16:49
;;3.2;;**28**
;
D NOW^%DTC S Y=% X ^DD("DD") W !!,"POST INIT STARTED at ",Y,"..."
W !,"...Updating the DRUG file for IV ADDITIVES and IV SOLUTIONS..."
S PSIUX="I" F Q1=52.6,52.7 F Q2=0:0 S Q2=$O(^PS(Q1,Q2)) Q:'Q2 S PSIUDA=$P($G(^(Q2,0)),"^",2) I PSIUDA W "." D ENS^PSGIU
W ! D ENAK
W !!,"...I must delete and rebuild the 'B' cross-reference of your Drug File (50)..."
K ^PSDRUG("B") S X=0 F Z=1:1 S X=$O(^PSDRUG(X)) Q:'X S Y=$P($G(^(X,0)),"^") I Y]"" S ^PSDRUG("B",$E(Y,1,40),X)="" W:'(Z#100) "." R Q:0 I W !,"...currently on entry number ",X," (",Y,")..."
K PSIUX,PSIUDA,Q1,Q2 D NOW^%DTC S Y=%,$P(^PS(59.7,1,20),"^",13)=% X ^DD("DD") W !,"...POST INIT COMPLETED at ",Y,"." Q
;
ENAK ; assign keys
K DIC S DIC="^DIC(19.1,",DIC(0)="LM",DLAYGO=19.1 F KEY="1^PSJ RPHARM","2^PSJ RNURSE","3^PSJ PHARM TECH" S X=$P(KEY,"^",2) W !,"...creating the ",X," key..." D ^DIC W "." D:Y'>0 FILE^DICN S @("KEY"_+KEY)=+Y
W !!,"...creating key holders..."
K PSJSF S KEYF=$D(^DD(19.12))>0+1,(HOLDER,PSJC,PSJSF,Q)=0 F S Q=$O(^PS(59.4,Q)) Q:'Q S PSJSF=PSJSF+1,PSJSF(PSJSF)=Q
F S HOLDER=$O(^XUSEC("PSJU RPH",HOLDER)) Q:'HOLDER S KEY=KEY2 D S PSJC=PSJC+1 W:'(PSJC#200) "."
.F Q=1:1:PSJSF I $D(^PS(59.4,PSJSF(Q),1,"B",HOLDER)) S KEY=KEY1 Q
.I '$D(^XUSEC($P("PSJ RPHARM^PSJ RNURSE","^",KEY=KEY2+1),HOLDER)) D @KEYF
S KEY=KEY3 F S HOLDER=$O(^XUSEC("PSJU PL",HOLDER)) Q:'HOLDER I '$D(^XUSEC("PSJ RPHARM",HOLDER)),'$D(^XUSEC("PSJ PHARM TECH",HOLDER)) D @KEYF S PSJC=PSJC+1 W:'(PSJC#200) "."
;
KDONE ;
K DA,DIC,DLAYGO,HOLDER,KEY,KEY1,KEY2,KEY3,KEYF,PSJC,PSJSF,Q,X,Y Q
;
1 ; laygo into key sub-file of 200
K DA,DIC S:'$D(^VA(200,HOLDER,51,0)) ^VA(200,HOLDER,51,0)="^"_$P(^DD(200,51,0),"^",2)
S DA(1)=HOLDER,DIC="^VA(200,"_HOLDER_",51,",DIC(0)="LM",DLAYGO=200.051,(DINUM,X)=KEY D FILE^DICN Q
;
2 ; laygo into holder sub-file of 19.1
K DA,DIC S:'$D(^DIC(19.1,KEY,2,0)) ^DIC(19.1,KEY,2,0)="^"_$P(^DD(19.1,2,0),"^",2)
S DA(1)=KEY,DIC="^DIC(19.1,"_KEY_",2,",DIC(0)="LM",DLAYGO=19.12,X=HOLDER D FILE^DICN Q
PSJPRE4P ; B'ham ISC/CML3 - POST INIT ;2/11/92 16:49
+1 ;;3.2;;**28**
+2 ;
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE !!,"POST INIT STARTED at ",Y,"..."
+4 WRITE !,"...Updating the DRUG file for IV ADDITIVES and IV SOLUTIONS..."
+5 SET PSIUX="I"
FOR Q1=52.6,52.7
FOR Q2=0:0
SET Q2=$ORDER(^PS(Q1,Q2))
IF 'Q2
QUIT
SET PSIUDA=$PIECE($GET(^(Q2,0)),"^",2)
IF PSIUDA
WRITE "."
DO ENS^PSGIU
+6 WRITE !
DO ENAK
+7 WRITE !!,"...I must delete and rebuild the 'B' cross-reference of your Drug File (50)..."
+8 KILL ^PSDRUG("B")
SET X=0
FOR Z=1:1
SET X=$ORDER(^PSDRUG(X))
IF 'X
QUIT
SET Y=$PIECE($GET(^(X,0)),"^")
IF Y]""
SET ^PSDRUG("B",$EXTRACT(Y,1,40),X)=""
IF '(Z#100)
WRITE "."
READ Q:0
IF $TEST
WRITE !,"...currently on entry number ",X," (",Y,")..."
+9 KILL PSIUX,PSIUDA,Q1,Q2
DO NOW^%DTC
SET Y=%
SET $PIECE(^PS(59.7,1,20),"^",13)=%
XECUTE ^DD("DD")
WRITE !,"...POST INIT COMPLETED at ",Y,"."
QUIT
+10 ;
ENAK ; assign keys
+1 KILL DIC
SET DIC="^DIC(19.1,"
SET DIC(0)="LM"
SET DLAYGO=19.1
FOR KEY="1^PSJ RPHARM","2^PSJ RNURSE","3^PSJ PHARM TECH"
SET X=$PIECE(KEY,"^",2)
WRITE !,"...creating the ",X," key..."
DO ^DIC
WRITE "."
IF Y'>0
DO FILE^DICN
SET @("KEY"_+KEY)=+Y
+2 WRITE !!,"...creating key holders..."
+3 KILL PSJSF
SET KEYF=$DATA(^DD(19.12))>0+1
SET (HOLDER,PSJC,PSJSF,Q)=0
FOR
SET Q=$ORDER(^PS(59.4,Q))
IF 'Q
QUIT
SET PSJSF=PSJSF+1
SET PSJSF(PSJSF)=Q
+4 FOR
SET HOLDER=$ORDER(^XUSEC("PSJU RPH",HOLDER))
IF 'HOLDER
QUIT
SET KEY=KEY2
Begin DoDot:1
+5 FOR Q=1:1:PSJSF
IF $DATA(^PS(59.4,PSJSF(Q),1,"B",HOLDER))
SET KEY=KEY1
QUIT
+6 IF '$DATA(^XUSEC($PIECE("PSJ RPHARM^PSJ RNURSE","^",KEY=KEY2+1),HOLDER))
DO @KEYF
End DoDot:1
SET PSJC=PSJC+1
IF '(PSJC#200)
WRITE "."
+7 SET KEY=KEY3
FOR
SET HOLDER=$ORDER(^XUSEC("PSJU PL",HOLDER))
IF 'HOLDER
QUIT
IF '$DATA(^XUSEC("PSJ RPHARM",HOLDER))
IF '$DATA(^XUSEC("PSJ PHARM TECH",HOLDER))
DO @KEYF
SET PSJC=PSJC+1
IF '(PSJC#200)
WRITE "."
+8 ;
KDONE ;
+1 KILL DA,DIC,DLAYGO,HOLDER,KEY,KEY1,KEY2,KEY3,KEYF,PSJC,PSJSF,Q,X,Y
QUIT
+2 ;
1 ; laygo into key sub-file of 200
+1 KILL DA,DIC
IF '$DATA(^VA(200,HOLDER,51,0))
SET ^VA(200,HOLDER,51,0)="^"_$PIECE(^DD(200,51,0),"^",2)
+2 SET DA(1)=HOLDER
SET DIC="^VA(200,"_HOLDER_",51,"
SET DIC(0)="LM"
SET DLAYGO=200.051
SET (DINUM,X)=KEY
DO FILE^DICN
QUIT
+3 ;
2 ; laygo into holder sub-file of 19.1
+1 KILL DA,DIC
IF '$DATA(^DIC(19.1,KEY,2,0))
SET ^DIC(19.1,KEY,2,0)="^"_$PIECE(^DD(19.1,2,0),"^",2)
+2 SET DA(1)=KEY
SET DIC="^DIC(19.1,"_KEY_",2,"
SET DIC(0)="LM"
SET DLAYGO=19.12
SET X=HOLDER
DO FILE^DICN
QUIT
