ORFIMM2 ;SLC/AGP - GENERIC EDIT IMMUNIZATION CONT ;Jan 18, 2023@15:04:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597**;Dec 17, 1997;Build 3
;
; Reference to IMMRPC^PXVRPC4 in ICR #7288
;
Q
;
;
GETDETLS(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE,LOC,SERREQ,SERMAX) ;
;
;Default Array passed in data from CPRS, defaults is only set when editing a record in CPRS.
;Editing from Coversheet and Reminders defaults can have the associated CPT/DX codes for the immunization record
;Editing from Encounter Form will not have associated CPT/DX codes for the immunization record
;
N CODECNT,CODEDCNT,CODETEMP,CPTTEMP,DXTEMP,DATALST,HASDEF,MATCH,NODE,X
N LOTCNT,LOTTEMP,LANG,LSTTYPE
N PIECE,SVIS,TYPE,TEMPTYPE,VIS,VISD,VISI,VIST
I ENCTYPE="H"!(ENCTYPE="D") S DATETIME=$$NOW^XLFDT()
S LSTTYPE="",HASDEF=$S($D(DEFAULTS):1,1:0)
S CODECNT=0,LANG="ENGLISH",SVIS=0,VISD=0,VISI=0,VIST="",CODEDCNT=0
S LOTCNT=0,LOTTEMP=""
S CPTTEMP="",DXTEMP=""
;get value associated to the immunization in VistA and set default values in the Immunization
;form in the FOR loop
D IMMRPC^PXVRPC4(.DATALST,ID,DATETIME,"L:"_$G(LOC))
S X=0 F S X=$O(^TMP("PXVIMMRPC",$J,X)) Q:X'>0 D
.S TEMPTYPE=""
.S NODE=^TMP("PXVIMMRPC",$J,X)
.S TYPE=$P(NODE,U)
.I TYPE="IMM" D
..I $P(NODE,U,12)=1 S SERREQ=1
..I +$P(NODE,U,9)>0 S SERMAX=+$P(NODE,U,9)
.I TYPE="CONTRA" Q
.I TYPE="CS" S TEMPTYPE=$S($P(NODE,U,2)="10D":"CODES DX",$P(NODE,U,2)="CPT":"CODES CPT",1:TEMPTYPE)
.S TEMPTYPE=$S(TYPE="VIS":"VIS OFFERED",TYPE="LOT":"LOT NUMBER",1:TEMPTYPE)
.;
.I TYPE="DEF" D
..I $P(NODE,U,2)'="",HASDEF=0 S DEFAULTS("ADMIN ROUTE")=$P(NODE,U,2)_U
..I $P(NODE,U,3)'="",HASDEF=0 S DEFAULTS("ADMIN SITE")=$P(NODE,U,3)_U
..I $P(NODE,U,4)'="",HASDEF=0 S DEFAULTS("DOSE")=$P(NODE,U,4)_U
..I $P(NODE,U,6)'="" S DEFAULTS("DOSE UNIT")=$P(NODE,U,6)_U
..I $P(NODE,U,7)'="" S DEFAULTS("DOSE UNIT")=$P(NODE,U,7)_U
.I TYPE="DEFC",HASDEF=0 D
..I $P(NODE,U,2)'="" S DEFAULTS("COMMENTS")=$P(NODE,U,2)_U
.;
.I $G(TEMPTYPE)="" Q
.;find most recent VIS statement reformat output
.I TEMPTYPE="VIS OFFERED" D
..S VIS=$P(NODE,U,3)_" "_$$FMTE^XLFDT($P(NODE,U,4))_" ("_$P(NODE,U,6)_")"
..S $P(NODE,U,3)=VIS
..I +$P(NODE,U,4)>VISD,$P(NODE,U,6)=LANG,$P(NODE,U,3)'["PEDIATRIC" D
...S VISD=$P(NODE,U,4),VISI=+$P(NODE,U,2),VIST=$P(NODE,U,3)
.;format expiration date to external date
.I TEMPTYPE="LOT NUMBER" D
..S $P(NODE,U,5)=$$FMTE^XLFDT($P(NODE,U,5))
..S LOTCNT=LOTCNT+1,LOTTEMP=$P(NODE,U,2,3)
.;format procedures codes display and determine the number of codes
.I TEMPTYPE["CODES" D Q
..S CODETEMP=""
..S CODETEMP=$P(NODE,U,4)_U_$P(NODE,U,3)_" ("_$P(NODE,U,5)_")"_U_$P(NODE,U,3)_U_$P(NODE,U,5)
..S CNT=CNT+1,RESULT(CNT)="DATA"_U_TEMPTYPE_U_CODETEMP
..I TEMPTYPE="CODES CPT" S CODECNT=CODECNT+1,CPTTEMP=CODETEMP Q
..I TEMPTYPE="CODES DX" S CODEDCNT=CODEDCNT+1,DXTEMP=CODETEMP
.;add data to result global
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_TEMPTYPE_U_$P(NODE,U,2,$L(NODE,U))
;
I HASDEF=1 D Q
.;Only step into if an edit
.I $$REMONLY^ORFIMM(ID)'="" D Q
..;based off settings in OR IMM REMINDER DIALOG parameter
..;immunizations defined in this parameters will only show CPT/DX codes prompt will be disabled
..;no matter how many CPT/DX codes is defined for the immunization.
..I $D(DEFAULTS("CODES CPT")) S DEFAULTS("CODES CPT")="0^1^"_DEFAULTS("CODES CPT")
..I $D(DEFAULTS("CODES DX")) S DEFAULTS("CODES DX")="0^1^"_DEFAULTS("CODES DX")
..I '$D(DEFAULTS("CODES CPT")) S DEFAULTS("CODES CPT")="0^0^^"
..I '$D(DEFAULTS("CODES DX")) S DEFAULTS("CODES DX")="0^0^^"
.;if not defined in the OR IMM REMINDER DIALOG parameter
.;determine if the CPT/DX prompts are disable/enabled based off the number of CPT/DX codes associated with
.;the immunization. If none set to disable
.I $D(DEFAULTS("CODES CPT")) S DEFAULTS("CODES CPT")=$S(CODECNT>1:"1^1^",1:"0^1^")_DEFAULTS("CODES CPT")
.I $D(DEFAULTS("CODES DX")) S DEFAULTS("CODES DX")=$S(CODEDCNT>1:"1^1^",1:"0^1^")_DEFAULTS("CODES DX")
.I '$D(DEFAULTS("CODES CPT")) S DEFAULTS("CODES CPT")="0^0^"
.I '$D(DEFAULTS("CODES DX")) S DEFAULTS("CODES DX")="0^0^"
;
;adding new record only section
I "AID"[ENCTYPE D
.I '$D(DEFAULTS("VISIT DATE TIME")) S DEFAULTS("VISIT DATE TIME")=DATETIME
.I DATETIME>$$GETMAXDT^ORFIMM1() S DEFAULTS("VISIT DATE TIME")=$$NOW^XLFDT()
I "AID"'[ENCTYPE,'$D(DEFAULTS("VISIT DATE TIME")) S DEFAULTS("VISIT DATE TIME")=$$NOW^XLFDT()
I HASDEF=0,VISI>0 S DEFAULTS("VIS OFFERED")=VISI_U_VIST
;if only one CPT code associated with the immunization set the value and disable the prompt
I CODECNT=1 S DEFAULTS("CODES CPT")=0_U_1_U_$P(CPTTEMP,U)_U_$P(CPTTEMP,U,2)
;if more than one CPT code associated with the immunization enable the prompt for user lookup
I CODECNT>1 D
.I $$REMONLY^ORFIMM(ID)'="" S DEFAULTS("CODES CPT")="0^1^^" Q
.S DEFAULTS("CODES CPT")="1^1^"
;if only one DX code associated with the immunization set the value and disable the prompt
I CODEDCNT=1 S DEFAULTS("CODES DX")=0_U_1_U_$P(DXTEMP,U)_U_$P(DXTEMP,U,2)
;if more than one DX code associated with the immunization enable the prompt for user lookup
I CODEDCNT>1 D
.I $$REMONLY^ORFIMM(ID)'="" S DEFAULTS("CODES DX")="0^1^^" Q
.S DEFAULTS("CODES DX")="1^1^"
I LOTCNT=1 S DEFAULTS("LOT NUMBER")=LOTTEMP Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORFIMM2 5349 printed Sep 23, 2025@20:07:09 Page 2
ORFIMM2 ;SLC/AGP - GENERIC EDIT IMMUNIZATION CONT ;Jan 18, 2023@15:04:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597**;Dec 17, 1997;Build 3
+2 ;
+3 ; Reference to IMMRPC^PXVRPC4 in ICR #7288
+4 ;
+5 QUIT
+6 ;
+7 ;
GETDETLS(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE,LOC,SERREQ,SERMAX) ;
+1 ;
+2 ;Default Array passed in data from CPRS, defaults is only set when editing a record in CPRS.
+3 ;Editing from Coversheet and Reminders defaults can have the associated CPT/DX codes for the immunization record
+4 ;Editing from Encounter Form will not have associated CPT/DX codes for the immunization record
+5 ;
+6 NEW CODECNT,CODEDCNT,CODETEMP,CPTTEMP,DXTEMP,DATALST,HASDEF,MATCH,NODE,X
+7 NEW LOTCNT,LOTTEMP,LANG,LSTTYPE
+8 NEW PIECE,SVIS,TYPE,TEMPTYPE,VIS,VISD,VISI,VIST
+9 IF ENCTYPE="H"!(ENCTYPE="D")
SET DATETIME=$$NOW^XLFDT()
+10 SET LSTTYPE=""
SET HASDEF=$SELECT($DATA(DEFAULTS):1,1:0)
+11 SET CODECNT=0
SET LANG="ENGLISH"
SET SVIS=0
SET VISD=0
SET VISI=0
SET VIST=""
SET CODEDCNT=0
+12 SET LOTCNT=0
SET LOTTEMP=""
+13 SET CPTTEMP=""
SET DXTEMP=""
+14 ;get value associated to the immunization in VistA and set default values in the Immunization
+15 ;form in the FOR loop
+16 DO IMMRPC^PXVRPC4(.DATALST,ID,DATETIME,"L:"_$GET(LOC))
+17 SET X=0
FOR
SET X=$ORDER(^TMP("PXVIMMRPC",$JOB,X))
if X'>0
QUIT
Begin DoDot:1
+18 SET TEMPTYPE=""
+19 SET NODE=^TMP("PXVIMMRPC",$JOB,X)
+20 SET TYPE=$PIECE(NODE,U)
+21 IF TYPE="IMM"
Begin DoDot:2
+22 IF $PIECE(NODE,U,12)=1
SET SERREQ=1
+23 IF +$PIECE(NODE,U,9)>0
SET SERMAX=+$PIECE(NODE,U,9)
End DoDot:2
+24 IF TYPE="CONTRA"
QUIT
+25 IF TYPE="CS"
SET TEMPTYPE=$SELECT($PIECE(NODE,U,2)="10D":"CODES DX",$PIECE(NODE,U,2)="CPT":"CODES CPT",1:TEMPTYPE)
+26 SET TEMPTYPE=$SELECT(TYPE="VIS":"VIS OFFERED",TYPE="LOT":"LOT NUMBER",1:TEMPTYPE)
+27 ;
+28 IF TYPE="DEF"
Begin DoDot:2
+29 IF $PIECE(NODE,U,2)'=""
IF HASDEF=0
SET DEFAULTS("ADMIN ROUTE")=$PIECE(NODE,U,2)_U
+30 IF $PIECE(NODE,U,3)'=""
IF HASDEF=0
SET DEFAULTS("ADMIN SITE")=$PIECE(NODE,U,3)_U
+31 IF $PIECE(NODE,U,4)'=""
IF HASDEF=0
SET DEFAULTS("DOSE")=$PIECE(NODE,U,4)_U
+32 IF $PIECE(NODE,U,6)'=""
SET DEFAULTS("DOSE UNIT")=$PIECE(NODE,U,6)_U
+33 IF $PIECE(NODE,U,7)'=""
SET DEFAULTS("DOSE UNIT")=$PIECE(NODE,U,7)_U
End DoDot:2
+34 IF TYPE="DEFC"
IF HASDEF=0
Begin DoDot:2
+35 IF $PIECE(NODE,U,2)'=""
SET DEFAULTS("COMMENTS")=$PIECE(NODE,U,2)_U
End DoDot:2
+36 ;
+37 IF $GET(TEMPTYPE)=""
QUIT
+38 ;find most recent VIS statement reformat output
+39 IF TEMPTYPE="VIS OFFERED"
Begin DoDot:2
+40 SET VIS=$PIECE(NODE,U,3)_" "_$$FMTE^XLFDT($PIECE(NODE,U,4))_" ("_$PIECE(NODE,U,6)_")"
+41 SET $PIECE(NODE,U,3)=VIS
+42 IF +$PIECE(NODE,U,4)>VISD
IF $PIECE(NODE,U,6)=LANG
IF $PIECE(NODE,U,3)'["PEDIATRIC"
Begin DoDot:3
+43 SET VISD=$PIECE(NODE,U,4)
SET VISI=+$PIECE(NODE,U,2)
SET VIST=$PIECE(NODE,U,3)
End DoDot:3
End DoDot:2
+44 ;format expiration date to external date
+45 IF TEMPTYPE="LOT NUMBER"
Begin DoDot:2
+46 SET $PIECE(NODE,U,5)=$$FMTE^XLFDT($PIECE(NODE,U,5))
+47 SET LOTCNT=LOTCNT+1
SET LOTTEMP=$PIECE(NODE,U,2,3)
End DoDot:2
+48 ;format procedures codes display and determine the number of codes
+49 IF TEMPTYPE["CODES"
Begin DoDot:2
+50 SET CODETEMP=""
+51 SET CODETEMP=$PIECE(NODE,U,4)_U_$PIECE(NODE,U,3)_" ("_$PIECE(NODE,U,5)_")"_U_$PIECE(NODE,U,3)_U_$PIECE(NODE,U,5)
+52 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_TEMPTYPE_U_CODETEMP
+53 IF TEMPTYPE="CODES CPT"
SET CODECNT=CODECNT+1
SET CPTTEMP=CODETEMP
QUIT
+54 IF TEMPTYPE="CODES DX"
SET CODEDCNT=CODEDCNT+1
SET DXTEMP=CODETEMP
End DoDot:2
QUIT
+55 ;add data to result global
+56 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_TEMPTYPE_U_$PIECE(NODE,U,2,$LENGTH(NODE,U))
End DoDot:1
+57 ;
+58 IF HASDEF=1
Begin DoDot:1
+59 ;Only step into if an edit
+60 IF $$REMONLY^ORFIMM(ID)'=""
Begin DoDot:2
+61 ;based off settings in OR IMM REMINDER DIALOG parameter
+62 ;immunizations defined in this parameters will only show CPT/DX codes prompt will be disabled
+63 ;no matter how many CPT/DX codes is defined for the immunization.
+64 IF $DATA(DEFAULTS("CODES CPT"))
SET DEFAULTS("CODES CPT")="0^1^"_DEFAULTS("CODES CPT")
+65 IF $DATA(DEFAULTS("CODES DX"))
SET DEFAULTS("CODES DX")="0^1^"_DEFAULTS("CODES DX")
+66 IF '$DATA(DEFAULTS("CODES CPT"))
SET DEFAULTS("CODES CPT")="0^0^^"
+67 IF '$DATA(DEFAULTS("CODES DX"))
SET DEFAULTS("CODES DX")="0^0^^"
End DoDot:2
QUIT
+68 ;if not defined in the OR IMM REMINDER DIALOG parameter
+69 ;determine if the CPT/DX prompts are disable/enabled based off the number of CPT/DX codes associated with
+70 ;the immunization. If none set to disable
+71 IF $DATA(DEFAULTS("CODES CPT"))
SET DEFAULTS("CODES CPT")=$SELECT(CODECNT>1:"1^1^",1:"0^1^")_DEFAULTS("CODES CPT")
+72 IF $DATA(DEFAULTS("CODES DX"))
SET DEFAULTS("CODES DX")=$SELECT(CODEDCNT>1:"1^1^",1:"0^1^")_DEFAULTS("CODES DX")
+73 IF '$DATA(DEFAULTS("CODES CPT"))
SET DEFAULTS("CODES CPT")="0^0^"
+74 IF '$DATA(DEFAULTS("CODES DX"))
SET DEFAULTS("CODES DX")="0^0^"
End DoDot:1
QUIT
+75 ;
+76 ;adding new record only section
+77 IF "AID"[ENCTYPE
Begin DoDot:1
+78 IF '$DATA(DEFAULTS("VISIT DATE TIME"))
SET DEFAULTS("VISIT DATE TIME")=DATETIME
+79 IF DATETIME>$$GETMAXDT^ORFIMM1()
SET DEFAULTS("VISIT DATE TIME")=$$NOW^XLFDT()
End DoDot:1
+80 IF "AID"'[ENCTYPE
IF '$DATA(DEFAULTS("VISIT DATE TIME"))
SET DEFAULTS("VISIT DATE TIME")=$$NOW^XLFDT()
+81 IF HASDEF=0
IF VISI>0
SET DEFAULTS("VIS OFFERED")=VISI_U_VIST
+82 ;if only one CPT code associated with the immunization set the value and disable the prompt
+83 IF CODECNT=1
SET DEFAULTS("CODES CPT")=0_U_1_U_$PIECE(CPTTEMP,U)_U_$PIECE(CPTTEMP,U,2)
+84 ;if more than one CPT code associated with the immunization enable the prompt for user lookup
+85 IF CODECNT>1
Begin DoDot:1
+86 IF $$REMONLY^ORFIMM(ID)'=""
SET DEFAULTS("CODES CPT")="0^1^^"
QUIT
+87 SET DEFAULTS("CODES CPT")="1^1^"
End DoDot:1
+88 ;if only one DX code associated with the immunization set the value and disable the prompt
+89 IF CODEDCNT=1
SET DEFAULTS("CODES DX")=0_U_1_U_$PIECE(DXTEMP,U)_U_$PIECE(DXTEMP,U,2)
+90 ;if more than one DX code associated with the immunization enable the prompt for user lookup
+91 IF CODEDCNT>1
Begin DoDot:1
+92 IF $$REMONLY^ORFIMM(ID)'=""
SET DEFAULTS("CODES DX")="0^1^^"
QUIT
+93 SET DEFAULTS("CODES DX")="1^1^"
End DoDot:1
+94 IF LOTCNT=1
SET DEFAULTS("LOT NUMBER")=LOTTEMP
QUIT
+95 QUIT
