- 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 Feb 18, 2025@23:58:01 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