PXVEDIT ;BIR/CML3,ADM - LOT NUMBER EDIT ;Nov 30, 2018@14:03
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,217**;Aug 12, 1996;Build 134
;
EN ; entry point for PXTT EDIT IMMUNIZATION LOT option
N PXVDEF,PXVFAC,PXVFIEN,PXVI,PXVOUT,PXVSTN,PXVTITLE,PXVY,X,Y
S PXVOUT=0,PXVFAC=""
D PICK,LIST I PXVFAC="" D END Q
D PICK1
FUNC ; select function
K DIR
S DIR("A",1)="1. Enter/Edit Immunization Lot"
S DIR("A",2)="2. Transfer Immunization Inventory Between Facilities"
S DIR("A",3)="3. Display/Print Immunization Inventory Report"
S DIR("A",4)=""
S DIR("A")="Enter a number"
S DIR("?",1)=" Enter '1' to update information for an existing immunization lot or"
S DIR("?",2)=" to enter a new immunization lot. Enter '2' to transfer vaccine inventory"
S DIR("?",3)=" from one facility to another. The number of doses to be moved is subtracted"
S DIR("?",4)=" from the transferring facility and added to the receiving facility."
S DIR("?")=" Enter '3' to display or print an immunization inventory report."
S DIR(0)="NO^1:3" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S PXVOUT=1 D END Q
I X["?" G PICK
I Y=2 D EN^PXVTRAN(PXVFIEN,PXVTITLE) D END Q
I Y=3 D ^PXVINV D END Q
F1 ; entry point for lot number enter/edit
N DA,DIE,DIC,DIDEL,DIR,DLAYGO,DR,DTOUT,DUOUT,PXVIEN,X,Y
F D LN Q:PXVOUT
K PXVOUT
Q
LN ; edit lot number or enter new lot number
W @IOF,!,?10,"Enter/Edit Immunization Lot for "_PXVTITLE,!
K DIC S DIC="^AUTTIML(",DIC(0)="AEMLZ",DLAYGO=9999999.41
S DIC("S")="I $P(^(0),""^"",10)=PXVFIEN!($P(^(0),""^"",10)="""")"
S DIC("DR")=".02;.04;.09;.03;.11;.12;.15;.18"
D ^DIC K DIC I $D(DTOUT)!$D(DUOUT)!(X="") S PXVOUT=1 D END Q
S PXVIEN=$P($G(Y),"^")
I $P(Y,"^",3)=1 K DA,DIE,DR S DA=PXVIEN,DIE=9999999.41,DR=".1////"_PXVFIEN D ^DIE D END Q
I $P(^AUTTIML(PXVIEN,0),"^",10)="" D LINK
EDIT ; edit existing lot number
I $D(^AUPNVIMM("LN",PXVIEN)) D D END Q
.W !!,"LOT NUMBER: "_$P(^AUTTIML(PXVIEN,0),"^")_"// ** Already assigned and cannot be edited. **",$C(7)
.S DA=PXVIEN,DIE=9999999.41,DR=".02;.04;.09;.03;.11;.12;.15;.18" D ^DIE
K DA,DIE,DR S DA=PXVIEN,(DIDEL,DIE)=9999999.41,DR=".01;.04;.02;.09;.03;.11;.12;.15;.18" D ^DIE
D END
Q
END K DA,DIE,DIC,DIDEL,DIR,DLAYGO,DR,DTOUT,DUOUT,PXVIEN,X,Y
Q
PICK W @IOF,"IMMUNIZATION INVENTORY FUNCTIONS",!
Q
PICK1 W @IOF,"IMMUNIZATION INVENTORY FUNCTIONS FOR "_PXVTITLE,!
Q
LIST ;
N PXVCT,PXVI,PXVINST,PXVJ,PXVSITE,PXVX,PXVY S PXVCT=0
W !,"Select associated VA facility from the list or enter another facility."
I $O(^AUTTIML("AF",0)) D
.S PXVI=0 F S PXVI=$O(^AUTTIML("AF",PXVI)) Q:'PXVI D SITE
E S PXVI=$$KSP^XUPARAM("INST") D SITE
S PXVI="" F S PXVI=$O(PXVINST(PXVI)) Q:PXVI="" S X=PXVINST(PXVI) D
.W !?10,$P(X,"^",2)_" ("_$P(X,"^",3)_")"
W !,"Inventory information to be updated or displayed will be related to"
W !,"the selected facility.",!
RD K DIR S DIR(0)="9999999.41,.1",DIR("A")="Enter the facility name or station number"
I PXVCT=1 S PXVI="",PXVI=$O(PXVINST(PXVI)),DIR("B")=$P(PXVINST(PXVI),"^",2)
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
I X="" W !,"This is a required entry." G RD
S PXVFAC=Y,PXVFIEN=+Y
S PXVY=$$GET1^DIQ(4,$P(PXVFAC,"^"),99),PXVFAC=PXVFAC_"^"_PXVY
S PXVTITLE=$P(PXVFAC,"^",2)_" ("_$P(PXVFAC,"^",3)_")"
Q
SITE ;
S PXVSITE=PXVI F PXVJ=.01,99 S PXVX=$$GET1^DIQ(4,PXVI,PXVJ),PXVSITE=PXVSITE_"^"_PXVX
S PXVINST($P(PXVSITE,"^",2))=PXVSITE,PXVCT=PXVCT+1
Q
LINK ;
S DIR("A")="Associate this lot number with "_PXVTITLE,DIR(0)="Y"
S DIR("?",1)=" Enter YES to associate this lot number entry exclusively with this facility."
S DIR("?",2)=" Enter NO if this immunization lot should remain not associated with any"
S DIR("?")=" specific facility or should be associated with a different facility."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
I Y K DA,DIE,DR S DA=PXVIEN,(DLAYGO,DIE)=9999999.41,DR=".1////"_PXVFIEN D ^DIE K DA,DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVEDIT 3914 printed Apr 09, 2024@21:30:22 Page 2
PXVEDIT ;BIR/CML3,ADM - LOT NUMBER EDIT ;Nov 30, 2018@14:03
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,217**;Aug 12, 1996;Build 134
+2 ;
EN ; entry point for PXTT EDIT IMMUNIZATION LOT option
+1 NEW PXVDEF,PXVFAC,PXVFIEN,PXVI,PXVOUT,PXVSTN,PXVTITLE,PXVY,X,Y
+2 SET PXVOUT=0
SET PXVFAC=""
+3 DO PICK
DO LIST
IF PXVFAC=""
DO END
QUIT
+4 DO PICK1
FUNC ; select function
+1 KILL DIR
+2 SET DIR("A",1)="1. Enter/Edit Immunization Lot"
+3 SET DIR("A",2)="2. Transfer Immunization Inventory Between Facilities"
+4 SET DIR("A",3)="3. Display/Print Immunization Inventory Report"
+5 SET DIR("A",4)=""
+6 SET DIR("A")="Enter a number"
+7 SET DIR("?",1)=" Enter '1' to update information for an existing immunization lot or"
+8 SET DIR("?",2)=" to enter a new immunization lot. Enter '2' to transfer vaccine inventory"
+9 SET DIR("?",3)=" from one facility to another. The number of doses to be moved is subtracted"
+10 SET DIR("?",4)=" from the transferring facility and added to the receiving facility."
+11 SET DIR("?")=" Enter '3' to display or print an immunization inventory report."
+12 SET DIR(0)="NO^1:3"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET PXVOUT=1
DO END
QUIT
+13 IF X["?"
GOTO PICK
+14 IF Y=2
DO EN^PXVTRAN(PXVFIEN,PXVTITLE)
DO END
QUIT
+15 IF Y=3
DO ^PXVINV
DO END
QUIT
F1 ; entry point for lot number enter/edit
+1 NEW DA,DIE,DIC,DIDEL,DIR,DLAYGO,DR,DTOUT,DUOUT,PXVIEN,X,Y
+2 FOR
DO LN
if PXVOUT
QUIT
+3 KILL PXVOUT
+4 QUIT
LN ; edit lot number or enter new lot number
+1 WRITE @IOF,!,?10,"Enter/Edit Immunization Lot for "_PXVTITLE,!
+2 KILL DIC
SET DIC="^AUTTIML("
SET DIC(0)="AEMLZ"
SET DLAYGO=9999999.41
+3 SET DIC("S")="I $P(^(0),""^"",10)=PXVFIEN!($P(^(0),""^"",10)="""")"
+4 SET DIC("DR")=".02;.04;.09;.03;.11;.12;.15;.18"
+5 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET PXVOUT=1
DO END
QUIT
+6 SET PXVIEN=$PIECE($GET(Y),"^")
+7 IF $PIECE(Y,"^",3)=1
KILL DA,DIE,DR
SET DA=PXVIEN
SET DIE=9999999.41
SET DR=".1////"_PXVFIEN
DO ^DIE
DO END
QUIT
+8 IF $PIECE(^AUTTIML(PXVIEN,0),"^",10)=""
DO LINK
EDIT ; edit existing lot number
+1 IF $DATA(^AUPNVIMM("LN",PXVIEN))
Begin DoDot:1
+2 WRITE !!,"LOT NUMBER: "_$PIECE(^AUTTIML(PXVIEN,0),"^")_"// ** Already assigned and cannot be edited. **",$CHAR(7)
+3 SET DA=PXVIEN
SET DIE=9999999.41
SET DR=".02;.04;.09;.03;.11;.12;.15;.18"
DO ^DIE
End DoDot:1
DO END
QUIT
+4 KILL DA,DIE,DR
SET DA=PXVIEN
SET (DIDEL,DIE)=9999999.41
SET DR=".01;.04;.02;.09;.03;.11;.12;.15;.18"
DO ^DIE
+5 DO END
+6 QUIT
END KILL DA,DIE,DIC,DIDEL,DIR,DLAYGO,DR,DTOUT,DUOUT,PXVIEN,X,Y
+1 QUIT
PICK WRITE @IOF,"IMMUNIZATION INVENTORY FUNCTIONS",!
+1 QUIT
PICK1 WRITE @IOF,"IMMUNIZATION INVENTORY FUNCTIONS FOR "_PXVTITLE,!
+1 QUIT
LIST ;
+1 NEW PXVCT,PXVI,PXVINST,PXVJ,PXVSITE,PXVX,PXVY
SET PXVCT=0
+2 WRITE !,"Select associated VA facility from the list or enter another facility."
+3 IF $ORDER(^AUTTIML("AF",0))
Begin DoDot:1
+4 SET PXVI=0
FOR
SET PXVI=$ORDER(^AUTTIML("AF",PXVI))
if 'PXVI
QUIT
DO SITE
End DoDot:1
+5 IF '$TEST
SET PXVI=$$KSP^XUPARAM("INST")
DO SITE
+6 SET PXVI=""
FOR
SET PXVI=$ORDER(PXVINST(PXVI))
if PXVI=""
QUIT
SET X=PXVINST(PXVI)
Begin DoDot:1
+7 WRITE !?10,$PIECE(X,"^",2)_" ("_$PIECE(X,"^",3)_")"
End DoDot:1
+8 WRITE !,"Inventory information to be updated or displayed will be related to"
+9 WRITE !,"the selected facility.",!
RD KILL DIR
SET DIR(0)="9999999.41,.1"
SET DIR("A")="Enter the facility name or station number"
+1 IF PXVCT=1
SET PXVI=""
SET PXVI=$ORDER(PXVINST(PXVI))
SET DIR("B")=$PIECE(PXVINST(PXVI),"^",2)
+2 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+3 IF X=""
WRITE !,"This is a required entry."
GOTO RD
+4 SET PXVFAC=Y
SET PXVFIEN=+Y
+5 SET PXVY=$$GET1^DIQ(4,$PIECE(PXVFAC,"^"),99)
SET PXVFAC=PXVFAC_"^"_PXVY
+6 SET PXVTITLE=$PIECE(PXVFAC,"^",2)_" ("_$PIECE(PXVFAC,"^",3)_")"
+7 QUIT
SITE ;
+1 SET PXVSITE=PXVI
FOR PXVJ=.01,99
SET PXVX=$$GET1^DIQ(4,PXVI,PXVJ)
SET PXVSITE=PXVSITE_"^"_PXVX
+2 SET PXVINST($PIECE(PXVSITE,"^",2))=PXVSITE
SET PXVCT=PXVCT+1
+3 QUIT
LINK ;
+1 SET DIR("A")="Associate this lot number with "_PXVTITLE
SET DIR(0)="Y"
+2 SET DIR("?",1)=" Enter YES to associate this lot number entry exclusively with this facility."
+3 SET DIR("?",2)=" Enter NO if this immunization lot should remain not associated with any"
+4 SET DIR("?")=" specific facility or should be associated with a different facility."
+5 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 IF Y
KILL DA,DIE,DR
SET DA=PXVIEN
SET (DLAYGO,DIE)=9999999.41
SET DR=".1////"_PXVFIEN
DO ^DIE
KILL DA,DIE,DR
+7 QUIT
