- PSIVREC ;BIR/CCH,PR-RECOMPILE IV STATS ;16 DEC 97 / 1:40 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- REC W !,"Enter Name of Drug to be recompiled" R !,"(if multiple names, separate by "",""): ",STR:DTIME W:'$T $C(7) G:'$T!("^"[STR) DONE I STR?1."?" S HELP="OMP" D ^PSIVHLP2 G REC
- S (ADDSTR,SOLSTR)="" F Z=1:1:$L(STR,",") S NM=$P(STR,",",Z) D LOOKUP I 'ADDSTR,'SOLSTR W ! G REC
- QUE S ZTRTN="ENQ^PSIVREC",ZTIO="",ZTDTH=$H,ZTDESC="Recompile IV Stats"
- F G="I7","I8","ADDSTR","SOLSTR" S ZTSAVE(G)=""
- D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
- DONE K %DT,ADDSTR,COST,D,DA,DAT,DATA,FLE,G,HELP,IV,NM,PCE,I7,I8,SOLSTR,STR,X,Y,Z,ZTSK,C D ENIVKV^PSGSETU Q
- LOOKUP W !,NM K DIC S X=NM,DIC(0)="EZ",DIC="^PS(52.6,",DIC("W")="W "" (Additive)""" D ^DIC
- I Y'>0 S DIC="^PS(52.7,",DIC("W")="W $P(^(0),U,3),"" SOLUTION""",X=NM D ^DIC I Y'>0 K DIC W !!,NM_" NOT FOUND" Q
- FOUND W !,$P(Y(0),"^")_" in the "_$S(DIC[52.6:"Additive",1:"Solution")_" File"
- I DIC[52.6 S ADDSTR=$S('ADDSTR:+Y,1:ADDSTR_","_+Y)
- E S SOLSTR=$S('SOLSTR:+Y,1:SOLSTR_","_+Y)
- K DIC Q
- ENQ ; done as background job to fix correct cost in stats file 50.8
- F IV=0:0 S IV=$O(^PS(50.8,IV)) Q:'IV I $D(^PS(50.8,IV,2)) F DAT=I7-1:0 S DAT=$O(^PS(50.8,IV,2,DAT)) Q:'DAT!(DAT>I8) D FNDRG
- D DONE S:$D(ZTQUEUED) ZTREQ="@" Q
- FNDRG Q:'$D(^PS(50.8,IV,2,DAT,2)) I ADDSTR S FLE=52.6 F PCE=1:1:$L(ADDSTR,",") S D=$P(ADDSTR,",",PCE) D FIX
- I SOLSTR S FLE=52.7 F PCE=1:1:$L(SOLSTR,",") S D=$P(SOLSTR,",",PCE) D FIX
- Q
- FIX I $D(^PS(50.8,IV,2,DAT,2,"AC",FLE,D)) S DA=$O(^(D,0)),COST=$P(^PS(FLE,D,0),"^",7),$P(^PS(50.8,IV,2,DAT,2,DA,0),"^",5)=COST Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVREC 1600 printed Apr 23, 2025@18:19:27 Page 2
- PSIVREC ;BIR/CCH,PR-RECOMPILE IV STATS ;16 DEC 97 / 1:40 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- REC WRITE !,"Enter Name of Drug to be recompiled"
- READ !,"(if multiple names, separate by "",""): ",STR:DTIME
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST!("^"[STR)
- GOTO DONE
- IF STR?1."?"
- SET HELP="OMP"
- DO ^PSIVHLP2
- GOTO REC
- +1 SET (ADDSTR,SOLSTR)=""
- FOR Z=1:1:$LENGTH(STR,",")
- SET NM=$PIECE(STR,",",Z)
- DO LOOKUP
- IF 'ADDSTR
- IF 'SOLSTR
- WRITE !
- GOTO REC
- QUE SET ZTRTN="ENQ^PSIVREC"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Recompile IV Stats"
- +1 FOR G="I7","I8","ADDSTR","SOLSTR"
- SET ZTSAVE(G)=""
- +2 DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"Queued."
- DONE KILL %DT,ADDSTR,COST,D,DA,DAT,DATA,FLE,G,HELP,IV,NM,PCE,I7,I8,SOLSTR,STR,X,Y,Z,ZTSK,C
- DO ENIVKV^PSGSETU
- QUIT
- LOOKUP WRITE !,NM
- KILL DIC
- SET X=NM
- SET DIC(0)="EZ"
- SET DIC="^PS(52.6,"
- SET DIC("W")="W "" (Additive)"""
- DO ^DIC
- +1 IF Y'>0
- SET DIC="^PS(52.7,"
- SET DIC("W")="W $P(^(0),U,3),"" SOLUTION"""
- SET X=NM
- DO ^DIC
- IF Y'>0
- KILL DIC
- WRITE !!,NM_" NOT FOUND"
- QUIT
- FOUND WRITE !,$PIECE(Y(0),"^")_" in the "_$SELECT(DIC[52.6:"Additive",1:"Solution")_" File"
- +1 IF DIC[52.6
- SET ADDSTR=$SELECT('ADDSTR:+Y,1:ADDSTR_","_+Y)
- +2 IF '$TEST
- SET SOLSTR=$SELECT('SOLSTR:+Y,1:SOLSTR_","_+Y)
- +3 KILL DIC
- QUIT
- ENQ ; done as background job to fix correct cost in stats file 50.8
- +1 FOR IV=0:0
- SET IV=$ORDER(^PS(50.8,IV))
- if 'IV
- QUIT
- IF $DATA(^PS(50.8,IV,2))
- FOR DAT=I7-1:0
- SET DAT=$ORDER(^PS(50.8,IV,2,DAT))
- if 'DAT!(DAT>I8)
- QUIT
- DO FNDRG
- +2 DO DONE
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- FNDRG if '$DATA(^PS(50.8,IV,2,DAT,2))
- QUIT
- IF ADDSTR
- SET FLE=52.6
- FOR PCE=1:1:$LENGTH(ADDSTR,",")
- SET D=$PIECE(ADDSTR,",",PCE)
- DO FIX
- +1 IF SOLSTR
- SET FLE=52.7
- FOR PCE=1:1:$LENGTH(SOLSTR,",")
- SET D=$PIECE(SOLSTR,",",PCE)
- DO FIX
- +2 QUIT
- FIX IF $DATA(^PS(50.8,IV,2,DAT,2,"AC",FLE,D))
- SET DA=$ORDER(^(D,0))
- SET COST=$PIECE(^PS(FLE,D,0),"^",7)
- SET $PIECE(^PS(50.8,IV,2,DAT,2,DA,0),"^",5)=COST
- QUIT
