ORFIMM ;SLC/AGP - GENERIC EDIT IMMUNIZATION ;May 18, 2023@16:44:45
;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597,588**;Dec 17, 1997;Build 29
;
; Reference to READENT^PXAPIIM in ICR #6387
; Reference to READVALS^PXAPIIM in ICR #6387
; Reference to IMMSITE^PXVRPC2 in ICR #7283
; Reference to IMMSRC^PXVRPC2 in ICR #7283
; Reference to IMAN^PXVRPC1 in ICR #7282
; Reference to GETICR^PXVRPC5 in ICR #7285
; Reference to IMMGRP^PXAPIIM in ICR #6387
; Reference to IMMRPC^PXVRPC4 in ICR #7284
; Reference to ^AUTTIMM( in ICR #1990
;
Q
;
LAYOUT(TYPE,RESULT) ;
N CNT
S CNT=0
; 1 2 3 4 5 6 7 8 9 10 11 12 13
; NAME^CAPTION^CONTROL^COL^ROW^COLSPAN^NEEDSORT^REQUIRED^ABOVELINE^ENABLED^SET DEFAULT^Default Internal value^Default External Value"
I TYPE=0 D Q
.S CNT=CNT+1,RESULT(CNT)="LOT NUMBER^Lot Number^ptCBO^0^0^1^1^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="EXPIRATION DATE^Expiration Date^ptLabel^1^0^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="MANUFACTURER^Manufacturer^ptLabel^2^0^1^0^0^0^1^"
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Administration Date^ptDateTime^0^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ENCOUNTER PROVIDER^Administered by^ptCBOLongList^1^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ORDERED BY POLICY^Administering by Policy^ptCheckBox^2^1^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ORDERING PROVIDER^Ordered by^ptCBOLongList^3^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ADMIN ROUTE^Route^ptCBO^0^2^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ADMIN SITE^Anatomic Location^ptCBO^1^2^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="SERIES^Series^ptCBO^2^2^1^1^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="DOSE^Dosage in mL^ptEdit^3^2^1^1^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="VIS OFFERED^Vaccine Information Statement^ptCheckListBox^0^3^2^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^2^3^1^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^3^3^1^0^0^1^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^4^4^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="OVERRIDE REASON^Override Reason^ptEdit^0^5^4^0^1^0^"
I TYPE=1 D Q
.S CNT=CNT+1,RESULT(CNT)="INFO SOURCE^Information Source^ptCBO^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Administration Date^ptDateBox^1^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="LOCATION^Outside Location^ptCBOFreeText^2^0^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="SERIES^Series^ptCBO^3^0^1^1^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="LOT NUMBER^Lot Number^ptEdit^0^1^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="EXPIRATION DATE^Expiration Date^ptDate^1^1^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="MANUFACTURER^Manufacturer^ptCBO^2^1^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ADMIN ROUTE^Route^ptCBO^0^2^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ADMIN SITE^Anatomic Location^ptCBO^1^2^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="DOSE^Dosage in ml^ptEdit^2^2^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^4^0^0^0^1^1^"
I TYPE=2 D Q
.S CNT=CNT+1,RESULT(CNT)="CONTRAINDICATED^Contraindication/Precaution Reason^ptCBO^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="STOP^Cancel Series and stop forecasting^ptCBO^1^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="WARN UNTIL DATE^Choose reschedule date^ptDate^2^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^1^3^0^0^0^1^1^"
I TYPE=3 D Q
.S CNT=CNT+1,RESULT(CNT)="REFUSAL^Reason for Refusal^ptCBO^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="STOP^Cancel Series and stop forecasting^ptCBO^1^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="WARN UNTIL DATE^Choose reschedule date^ptDate^2^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="GRPLIST^Immunizations in group^ptListBox^0^1^1^0^0^0^1^"
.S CNT=CNT+1,RESULT(CNT)="CVXONLY^Limit Refusal to ^ptCBO^0^1^2^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^2^3^0^0^0^1^1^"
I TYPE=4 D Q
.S CNT=CNT+1,RESULT(CNT)="DISPLAY^Details^ptMemo^0^0^1^0^1^0^0^1^"
I TYPE=5 D Q
.S CNT=CNT+1,RESULT(CNT)="PLACEMENT IEN^Last Placement^ptLabel^0^0^2^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="READING^Measurements^ptCBO^0^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="RESULTS^Interpretation^ptCBO^1^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateTime^0^2^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ENCOUNTER PROVIDER^Read By^ptCBOLongList^1^2^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^2^0^0^0^1^1^"
Q
;
BLDLAYOT(RESULTS,INPUTS,TYPE) ;
N CNT,DATA,DATA1,DATA2,EXT,INT,NAME,NODE,LAYOUT,PARM,PARR,PIECE,PRMPTS,TEMP,X
S DATA=$G(INPUTS(1)),DATA1=$G(INPUTS(2)),DATA2=$G(INPUTS(3))
D LAYOUT(TYPE,.LAYOUT)
D BLDPRMPT^ORFEDT(.PRMPTS)
D BLDPARR^ORFEDT(.PARR)
S X=0,CNT=0 F S X=$O(LAYOUT(X)) Q:X'>0 D
.S NODE=$G(LAYOUT(X))
.S NAME=$P(NODE,U)
.S INT="",EXT=""
.S PARM=$G(PARR(NAME)) I PARM="" Q
.S PIECE=+PRMPTS(PARM) I PIECE=0 Q
.S TEMP=$P(DATA,U,PIECE)
.I PARM="pnumImmRoute" S EXT=$P(TEMP,";"),INT=$P(TEMP,";",3)
.I PARM="pnumImmSite" S EXT=$P(TEMP,";"),INT=$P(TEMP,";",3)
.I PARM="pnumImmLot" S EXT=$P(TEMP,";"),INT=$P(TEMP,";",2)
.I PARM="pnumImmManufacturer" S EXT=TEMP
.I PARM="pnumExpirationDate" S INT=TEMP I +INT>0 S EXT=$$FMTE^XLFDT(INT)
.I PARM="pnumImmDosage" S EXT=$P(TEMP,";"),INT=EXT
.I PARM="pnumImmOrderByIEN" S INT=TEMP I INT>0 S EXT=$$GET1^DIQ(200,INT_",",.01)
.I PARM="pnumAdminByPolicy" S INT=TEMP
.I PARM="pnumImmSeries" S INT=TEMP
.I PARM="pnumProvider" S INT=TEMP I INT>0 S EXT=$$GET1^DIQ(200,INT_",",.01)
.I PARM="pnumComment" S TEMP=$P(DATA1,U,3) S EXT=TEMP,INT=TEMP
.I PARM="pnumImmOverride" S TEMP=$P(DATA2,U,3) S EXT=TEMP,INT=TEMP
.I PARM="pnumDataSource" S EXT=$P(TEMP,";"),INT=$P(TEMP,";",2)
.I PARM="pnumIMMVIS" S INT=$$VIS(TEMP)
.I PARM="pnumImmContra" S INT=+$P(DATA,U,2),EXT=$P(DATA,U,4)
.I PARM="pnumWarnDate" D
. . S INT=TEMP
. . S CNT=CNT+1
. . S RESULTS(CNT)="STOP"_U_$S(INT>1:0_U_"No",1:1_U_"Yes")
.I PARM="pnumImmRefused" S INT=+$P(DATA,U,2),EXT=$P(DATA,U,4)
.I PARM="pnumAdminDate" S INT=TEMP,EXT=TEMP
.I PARM="pnumRefusedGroup" S INT=TEMP ;S INT='$P(DATA,U,9)
.I INT="@" S INT=""
.I EXT="@" S EXT=""
.S CNT=CNT+1,RESULTS(CNT)=NAME_U_INT_U_EXT
Q
;
GET(RESULT,DATAARR,DEFAULTS) ;
N ADMINBY,CNT,DATETIME,ENCTYPE,ERRMSG,FROMCVR,HASDEF,ID,IDX,LAYOUT,LOC,LOCLIST,NAME
N NEEDOVER,NODE,ORDERBY,PAT,PARR,PRMPTS,SERMAX,SERREQ,TEMP,TYPE,VIMMDOC,VSTSTR
S HASDEF=$S($D(DEFAULTS):1,1:0)
S ID=DATAARR("ID"),NAME=DATAARR("NAME"),TYPE=DATAARR("DOCUMENTTYPE"),DATETIME=DATAARR("DATETIME"),NEEDOVER=DATAARR("NEEDSOVERRIDE")
S VSTSTR=DATAARR("VISITSTR"),LOC=$P(VSTSTR,";")
S VIMMDOC=$S($D(DATAARR("VIMMTYPE")):$G(DATAARR("VIMMTYPE")),1:"")
S FROMCVR=+$G(DATAARR("FROMCOVER"))
S PAT=$G(DATAARR("PATIENTID"))
S ENCTYPE=$G(DATAARR("ENCOUNTERTYPE"))
S ADMINBY=$G(DATAARR("USERIEN"))_U_$G(DATAARR("USERNAME"))
S ORDERBY=$G(DATAARR("ENCOUNTERPROVIDERIEN"))_U_$G(DATAARR("ENCOUNTERPROVIDERNAME"))
S CNT=0,SERREQ=0,SERMAX=0
S ERRMSG=""
I TYPE=0,FROMCVR=1 S ERRMSG=$$REMONLY(ID,TYPE)
I ERRMSG'="" S RESULT(0)=-1_U_ERRMSG
D BLDPRMPT^ORFEDT(.PRMPTS)
D BLDPARR^ORFEDT(.PARR)
D GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PAT,.CNT,.RESULT,.DEFAULTS,.SERMAX,.SERREQ,.LOCLIST)
I '$D(DEFAULTS("ENCOUNTER PROVIDER")) S DEFAULTS("ENCOUNTER PROVIDER")=ADMINBY
I '$D(DEFAULTS("ORDERING PROVIDER")) S DEFAULTS("ORDERING PROVIDER")=ORDERBY
D LAYOUT(TYPE,.LAYOUT)
I TYPE=0 D
.I $G(DEFAULTS("OVERRIDE REASON"))="",NEEDOVER S DEFAULTS("OVERRIDE REASON")=""
.S CNT=CNT+1,RESULT(CNT)="LAYOUT^4^6"
I TYPE=1 S CNT=CNT+1,RESULT(CNT)="LAYOUT^4^4"
I TYPE=2 S CNT=CNT+1,RESULT(CNT)="LAYOUT^3^2"
I TYPE=3 S CNT=CNT+1,RESULT(CNT)="LAYOUT^3^3"
I TYPE=4 S CNT=CNT+1,RESULT(CNT)="LAYOUT^1^1"
I TYPE=5 S CNT=CNT+1,RESULT(CNT)="LAYOUT^2^4"
S IDX=0 F S IDX=$O(LAYOUT(IDX)) Q:IDX'>0 D
.S NODE=LAYOUT(IDX)
.I $P(NODE,U)="SERIES",TYPE=0 D
..I SERREQ=1 S $P(NODE,U,8)=1
..I SERMAX>0 S $P(NODE,U,9)=1
.I $P(NODE,U)="CVXONLY" S $P(NODE,U,2)=$P(NODE,U,2)_NAME
.I $P(NODE,U)="ADMIN SITE",$D(LOCLIST)>1 S $P(NODE,U,9)=1
.I $P(NODE,U)="ORDERING PROVIDER",+$$GETDEF("ORDERED BY POLICY",TYPE,.DEFAULTS) S $P(NODE,U,11)=0
.I $P(NODE,U)="DOSE",HASDEF=1,$G(DEFAULTS("DOSE UNIT"))'="",$P(DEFAULTS("DOSE UNIT"),U)'="mL",DEFAULTS("COMMENTS")["Dosage:" D
..S $P(NODE,U,10)=0
.S TEMP=$$GETDEF($P(NODE,U),TYPE,.DEFAULTS)
.S CNT=CNT+1,RESULT(CNT)=NODE_TEMP
.I $P(NODE,U)="DOSE",$P($G(DEFAULTS("DOSE UNIT")),U)'="" S $P(RESULT(CNT),U,2)="Dosage in "_$P(DEFAULTS("DOSE UNIT"),U)
Q
;
GETDEF(NAME,TYPE,DEFAULT) ;
N CNT,EXT,INT,RESULT,TEMP
S RESULT=""
I '$D(DEFAULT(NAME)) D Q RESULT
.I NAME'["CODES" S RESULT=U
.I NAME="OVERRIDE REASON" S RESULT=0_U_1_U Q
.I RESULT'="" Q
.S RESULT=1_U_1_U_U
I NAME="VIS OFFERED" D Q RESULT
.I $D(DEFAULT(NAME))=1 S RESULT=DEFAULT(NAME) Q
.S INT="",EXT=""
.S CNT=0 F S CNT=$O(DEFAULT(NAME,CNT)) Q:CNT'>0 D
..S TEMP=$G(DEFAULT(NAME,CNT)) I TEMP="" Q
..S INT=$S(INT'="":";"_$P(TEMP,U),1:$P(TEMP,U))
..S EXT=$S(EXT'="":";"_$P(TEMP,U),1:$P(TEMP,U))
. S RESULT=INT_U_EXT
I NAME="OVERRIDE REASON" D Q RESULT
.S TEMP=DEFAULT("OVERRIDE REASON")
.I NEEDOVER=1 S RESULT=1_U_1_U_TEMP
I NAME="GRPLIST" D Q RESULT
.I DEFAULT("GRPLIST")="NONE" S RESULT=0_U Q
.S RESULT=1_U
I NAME="CVXONLY" D Q RESULT
.S RESULT=$S(DEFAULT("GRPLIST")="NONE":0,1:1)_U_1_U
.S RESULT=RESULT_$G(DEFAULT("CVXONLY"))
;.I +$$GETDEF("ORDERED BY POLICY",TYPE,.DEFAULTS) S RESULT=U Q
;.S RESULT=ENCOPIEN_U_ENCOPNAM Q
S RESULT=$G(DEFAULT(NAME))
I RESULT="" S RESULT=U
Q RESULT
;
GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PAT,CNT,RESULT,DEFAULTS,SERMAX,SERREQ,LOCLIST) ;
N NOTEARR,TEMP,X
I TYPE=0 D Q
.;S CODECNT=0
.D GETDETLS^ORFIMM2(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE,LOC,.SERREQ,.SERMAX)
.D GETROUTE^ORFIMM1(.RESULT,.CNT,.DEFAULTS,.LOCLIST)
.D GETSITE(.RESULT,.CNT,.DEFAULTS,.LOCLIST)
.D GETSERS(.RESULT,.CNT,.DEFAULTS,SERREQ,SERMAX)
I TYPE=1 D Q
.D GETINFO(.RESULT,.CNT,.DEFAULTS)
.D GETSITE(.RESULT,.CNT,.DEFAULTS)
.D GETROUTE^ORFIMM1(.RESULT,.CNT,.DEFAULTS)
.D GETSERS(.RESULT,.CNT,.DEFAULTS,SERREQ,SERMAX)
.D GETMANF(.RESULT,.CNT,.DEFAULTS)
.D GETLOC(.RESULT,.CNT,.DEFAULTS)
.D GETDLOC(.RESULT,.CNT,.DEFAULTS)
I TYPE=2 D Q
.D GETCONT(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE,$G(LOC))
.D GETSTOP^ORFIMM1(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
I TYPE=3 D Q
.D GETREFUS(.RESULT,.CNT,.DEFAULTS,LOC)
.D GETSTOP^ORFIMM1(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
.D GETGROUP(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
.D GETCVX(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
I TYPE=4 D Q
.S TEMP=$S(VIMMDOC["Admin":0,VIMMDOC["Hist":1,VIMMDOC["Contr":2,VIMMDOC["Ref":3,1:-1)
.D GETTEXT^ORFIMM1(.NOTEARR,.DEFAULTS,ID,NAME,TEMP,DATETIME,LOC,1)
.S X=0 F S X=$O(NOTEARR(X)) Q:X'>0 D
..S CNT=CNT+1,RESULT(CNT)="DATA WORD PROCESSING"_U_"DISPLAY"_U_NOTEARR(X)
I TYPE=5 D
.D GETREAD(.RESULT,.CNT,.DEFAULTS,PAT)
.I "AID"[ENCTYPE S DEFAULTS("VISIT DATE TIME")=U_DATETIME
.I "AID"'[ENCTYPE S DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
Q
;
GETREAD(RESULT,CNT,DEFAULTS,PAT) ;
N ORARR,X,TEMP
D READENT^PXAPIIM(.ORARR,PAT)
I ORARR(1)="" Q
S DEFAULTS("PLACEMENT IEN")=$P(ORARR(1),U)_U_$P(ORARR(1),U,2)_" placed on: "_$TR($$FMTE^XLFDT($P(ORARR(1),U,3),"2ZM"),"@"," ")
K ORARR D READVALS^PXAPIIM(.ORARR)
F X=$P(ORARR("RANGE"),":"):1:$P(ORARR("RANGE"),":",2) S CNT=CNT+1,RESULT(CNT)="DATA^READING"_U_X_U_X
S TEMP="" F S TEMP=$O(ORARR("CODES",TEMP)) Q:TEMP="" D
.S CNT=CNT+1,RESULT(CNT)="DATA^RESULTS^"_$P(TEMP,":")_U_$P(TEMP,":",2)
Q
;
GETSITE(RESULT,CNT,DEFAULT,LOCLIST) ;
N DATALST,ID,X
D IMMSITE^PXVRPC2(.DATALST,"S:A")
;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"ADMIN SITE"_U_"NUMBER"_U_4
S X=0 F S X=$O(DATALST(X)) Q:X'>0 D
.I DATALST(X)'[U Q
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"ADMIN SITE"_U_DATALST(X)
.I $D(LOCLIST)>1 D
..S ID=0 F S ID=$O(LOCLIST(ID)) Q:ID'>0 D
...I ID'=+DATALST(X) Q
...S CNT=CNT+1,RESULT(CNT)="LINE"_U_"ADMIN SITE"_U_DATALST(X)
Q
;
GETSERS(RESULT,CNT,DEFAULT,SERREQ,SERMAX) ;
N DATALST,X
D GETSET^ORWPCE2(.DATALST,9000010.11,.04,1)
;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"SERIES"_U_"NUMBER"_U_2
S X="" F S X=$O(DATALST(X)) Q:X="" D
.I $P(DATALST(X),U)="@",SERREQ=1 Q
.I SERMAX>0,+DATALST(X)>0,+DATALST(X)'>SERMAX S CNT=CNT+1,RESULT(CNT)="LINE"_U_"SERIES"_U_DATALST(X)
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"SERIES"_U_DATALST(X)
Q
;
GETINFO(RESULT,CNT,DEFAULTS) ;
N DATALIST,ORNAME,ORNODE,X
D IMMSRC^PXVRPC2(.DATALIST,"S:AH")
S X=0 F S X=$O(DATALIST(X)) Q:X'>0 D
.S ORNODE=$G(DATALIST(X))
.S ORNAME=$P(ORNODE,U,2)
.I ORNAME["-" S ORNAME=$$TRIM^XLFSTR($P(ORNAME,"-",2))
.S $P(ORNODE,U,2)=ORNAME
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"INFO SOURCE"_U_ORNODE
Q
;
GETLOC(RESULT,CNT,DEFAULTS) ;
N DATALIST,X
D HISTLOC^ORQQPX(.DATALIST)
S X=0 F S X=$O(^TMP("OR",$J,"LOC",X)) Q:X'>0 D
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"LOCATION"_U_^TMP("OR",$J,"LOC",X)
Q
;
GETDLOC(RESULT,CNT,DEFAULTS) ;
N DATALIST,X
D GETDEFOL^ORQQPX(.DATALIST)
S X=0 F S X=$O(DATALIST(X)) Q:X'>0 D
.S CNT=CNT+1,RESULT(CNT)="DATA DEFAULT"_U_"LOCATION"_U_DATALIST(X)
Q
;
GETMANF(RESULT,CNT,DEFAULTS) ;
N DATALIST,X
D IMAN^PXVRPC1(.DATALIST,"S:B","",1)
;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"INFO SOURCE"_U_"NUMBER"_U_4
S X=0 F S X=$O(^TMP("PXVLST",$J,X)) Q:X'>0 D
.I +$P(^TMP("PXVLST",$J,X),U)=-1 Q
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"MANUFACTURER"_U_^TMP("PXVLST",$J,X)
Q
;
GETREFUS(RESULT,CNT,DEFAULTS,LOC) ;
N DATALIST,X
D GETICR^PXVRPC5(.DATALIST,920.5,"S:A","",LOC)
S X=0 F S X=$O(DATALIST(X)) Q:X'>0 D
.S $P(DATALIST(X),U)=+$P(DATALIST(X),U)
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"REFUSAL"_U_DATALIST(X)
Q
;
GETGROUP(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE) ;
N GRP,IEN,OCNT,ORGRPS
S OCNT=CNT
D IMMGRP^PXAPIIM(.ORGRPS,ID)
S GRP="" F S GRP=$O(ORGRPS("VG",GRP)) Q:GRP="" D
.S IEN=0 F S IEN=$O(ORGRPS("VG",GRP,IEN)) Q:IEN'>0 D
..S CNT=CNT+1,RESULT(CNT)="DATA"_U_"GRPLIST"_U_IEN_U_ORGRPS("VG",GRP,IEN)
..;S CNT=CNT+1,RESULT(CNT)="DATA WORD PROCESSING"_U_"GRPLIST"_U_ORGRPS("VG",GRP,IEN)
I OCNT=CNT S DEFAULTS("GRPLIST")="NONE" Q
S DEFAULTS("GRPLIST")="POPULATED"
Q
;
GETCVX(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE) ;
S CNT=CNT+1,RESULT(CNT)="DATA"_U_"CVXONLY"_U_0_U_"No (Refusal of all immunizations in this group)"
S CNT=CNT+1,RESULT(CNT)="DATA"_U_"CVXONLY"_U_1_U_"Yes (Refusal of only this specific formulation of vaccine)"
I $G(DEFAULTS("CVXONLY"))="" S DEFAULTS("CVXONLY")=0_U_"No (Refusal of all immunizations in this group)"
Q
;
GETCONT(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE,LOC) ;
N DATALST,NODE,X
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 NODE=^TMP("PXVIMMRPC",$J,X)
.I $P(NODE,U)'="CONTRA" Q
.S $P(NODE,U,3)=$S($P(NODE,U,7)="P":$P(NODE,U,3)_" (PRECAUTION)",$P(NODE,U,7)="C":$P(NODE,U,3)_" (CONTRAINDICATED)",1:$P(NODE,U,3))
.S $P(NODE,U,2)=+$P(NODE,U,2)
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_"CONTRAINDICATED"_U_$P(NODE,U,2,$L(NODE,U))
Q
;
REMONLY(ID,TYPE) ;
N NAME,IDX,ORERR,ORVALUE,RESULT
S RESULT=""
D GETLST^XPAR(.ORVALUE,"ALL","OR IMM REMINDER DIALOG","I",.ORERR)
S IDX=0 F S IDX=$O(ORVALUE(IDX)) Q:IDX'>0!(RESULT'="") D
. I ORVALUE(IDX)=ID D
..S NAME=$P($G(^AUTTIMM(ID,0)),U) S RESULT=NAME_" administration can only be documented through a Reminder Dialog"
Q RESULT
;
VIS(VALUE) ;
N IMMVIS,IMMVISDT,IMMVISENTRY,PXSEQ,PXX,RESULT,X
S PXSEQ=0,RESULT=""
F PXX=1:1:$L(VALUE,";") D
. S IMMVISENTRY=$$TRIM^XLFSTR($P(VALUE,";",PXX))
. S IMMVIS=$P(IMMVISENTRY,"/",1)
. I 'IMMVIS Q
. S RESULT=$S(RESULT="":IMMVIS,1:RESULT_";"_IMMVIS)
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORFIMM 15939 printed Sep 23, 2025@20:07:07 Page 2
ORFIMM ;SLC/AGP - GENERIC EDIT IMMUNIZATION ;May 18, 2023@16:44:45
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597,588**;Dec 17, 1997;Build 29
+2 ;
+3 ; Reference to READENT^PXAPIIM in ICR #6387
+4 ; Reference to READVALS^PXAPIIM in ICR #6387
+5 ; Reference to IMMSITE^PXVRPC2 in ICR #7283
+6 ; Reference to IMMSRC^PXVRPC2 in ICR #7283
+7 ; Reference to IMAN^PXVRPC1 in ICR #7282
+8 ; Reference to GETICR^PXVRPC5 in ICR #7285
+9 ; Reference to IMMGRP^PXAPIIM in ICR #6387
+10 ; Reference to IMMRPC^PXVRPC4 in ICR #7284
+11 ; Reference to ^AUTTIMM( in ICR #1990
+12 ;
+13 QUIT
+14 ;
LAYOUT(TYPE,RESULT) ;
+1 NEW CNT
+2 SET CNT=0
+3 ; 1 2 3 4 5 6 7 8 9 10 11 12 13
+4 ; NAME^CAPTION^CONTROL^COL^ROW^COLSPAN^NEEDSORT^REQUIRED^ABOVELINE^ENABLED^SET DEFAULT^Default Internal value^Default External Value"
+5 IF TYPE=0
Begin DoDot:1
+6 SET CNT=CNT+1
SET RESULT(CNT)="LOT NUMBER^Lot Number^ptCBO^0^0^1^1^1^0^1^1^"
+7 SET CNT=CNT+1
SET RESULT(CNT)="EXPIRATION DATE^Expiration Date^ptLabel^1^0^1^0^0^0^1^1^"
+8 SET CNT=CNT+1
SET RESULT(CNT)="MANUFACTURER^Manufacturer^ptLabel^2^0^1^0^0^0^1^"
+9 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Administration Date^ptDateTime^0^1^1^0^1^0^1^1^"
+10 SET CNT=CNT+1
SET RESULT(CNT)="ENCOUNTER PROVIDER^Administered by^ptCBOLongList^1^1^1^0^1^0^1^1^"
+11 SET CNT=CNT+1
SET RESULT(CNT)="ORDERED BY POLICY^Administering by Policy^ptCheckBox^2^1^1^0^0^0^1^1^"
+12 SET CNT=CNT+1
SET RESULT(CNT)="ORDERING PROVIDER^Ordered by^ptCBOLongList^3^1^1^0^1^0^1^1^"
+13 SET CNT=CNT+1
SET RESULT(CNT)="ADMIN ROUTE^Route^ptCBO^0^2^1^0^1^0^1^1^"
+14 SET CNT=CNT+1
SET RESULT(CNT)="ADMIN SITE^Anatomic Location^ptCBO^1^2^1^0^1^0^1^1^"
+15 SET CNT=CNT+1
SET RESULT(CNT)="SERIES^Series^ptCBO^2^2^1^1^0^0^1^1^"
+16 SET CNT=CNT+1
SET RESULT(CNT)="DOSE^Dosage in mL^ptEdit^3^2^1^1^1^0^1^1^"
+17 SET CNT=CNT+1
SET RESULT(CNT)="VIS OFFERED^Vaccine Information Statement^ptCheckListBox^0^3^2^0^0^0^1^1^"
+18 SET CNT=CNT+1
SET RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^2^3^1^0^1^0^"
+19 SET CNT=CNT+1
SET RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^3^3^1^0^0^1^"
+20 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^4^4^0^0^0^1^1^"
+21 SET CNT=CNT+1
SET RESULT(CNT)="OVERRIDE REASON^Override Reason^ptEdit^0^5^4^0^1^0^"
End DoDot:1
QUIT
+22 IF TYPE=1
Begin DoDot:1
+23 SET CNT=CNT+1
SET RESULT(CNT)="INFO SOURCE^Information Source^ptCBO^0^0^1^0^1^0^1^1^"
+24 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Administration Date^ptDateBox^1^0^1^0^1^0^1^1^"
+25 SET CNT=CNT+1
SET RESULT(CNT)="LOCATION^Outside Location^ptCBOFreeText^2^0^1^0^0^0^1^1^"
+26 SET CNT=CNT+1
SET RESULT(CNT)="SERIES^Series^ptCBO^3^0^1^1^0^0^1^1^"
+27 SET CNT=CNT+1
SET RESULT(CNT)="LOT NUMBER^Lot Number^ptEdit^0^1^1^0^0^0^1^1^"
+28 SET CNT=CNT+1
SET RESULT(CNT)="EXPIRATION DATE^Expiration Date^ptDate^1^1^1^0^0^0^1^1^"
+29 SET CNT=CNT+1
SET RESULT(CNT)="MANUFACTURER^Manufacturer^ptCBO^2^1^1^0^0^0^1^1^"
+30 SET CNT=CNT+1
SET RESULT(CNT)="ADMIN ROUTE^Route^ptCBO^0^2^1^0^0^0^1^1^"
+31 SET CNT=CNT+1
SET RESULT(CNT)="ADMIN SITE^Anatomic Location^ptCBO^1^2^1^0^0^0^1^1^"
+32 SET CNT=CNT+1
SET RESULT(CNT)="DOSE^Dosage in ml^ptEdit^2^2^1^0^0^0^1^1^"
+33 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^4^0^0^0^1^1^"
End DoDot:1
QUIT
+34 IF TYPE=2
Begin DoDot:1
+35 SET CNT=CNT+1
SET RESULT(CNT)="CONTRAINDICATED^Contraindication/Precaution Reason^ptCBO^0^0^1^0^1^0^1^1^"
+36 SET CNT=CNT+1
SET RESULT(CNT)="STOP^Cancel Series and stop forecasting^ptCBO^1^0^1^0^1^0^1^1^"
+37 SET CNT=CNT+1
SET RESULT(CNT)="WARN UNTIL DATE^Choose reschedule date^ptDate^2^0^1^0^1^0^1^1^"
+38 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^1^3^0^0^0^1^1^"
End DoDot:1
QUIT
+39 IF TYPE=3
Begin DoDot:1
+40 SET CNT=CNT+1
SET RESULT(CNT)="REFUSAL^Reason for Refusal^ptCBO^0^0^1^0^1^0^1^1^"
+41 SET CNT=CNT+1
SET RESULT(CNT)="STOP^Cancel Series and stop forecasting^ptCBO^1^0^1^0^1^0^1^1^"
+42 SET CNT=CNT+1
SET RESULT(CNT)="WARN UNTIL DATE^Choose reschedule date^ptDate^2^0^1^0^1^0^1^1^"
+43 SET CNT=CNT+1
SET RESULT(CNT)="GRPLIST^Immunizations in group^ptListBox^0^1^1^0^0^0^1^"
+44 SET CNT=CNT+1
SET RESULT(CNT)="CVXONLY^Limit Refusal to ^ptCBO^0^1^2^0^1^0^"
+45 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^2^3^0^0^0^1^1^"
End DoDot:1
QUIT
+46 IF TYPE=4
Begin DoDot:1
+47 SET CNT=CNT+1
SET RESULT(CNT)="DISPLAY^Details^ptMemo^0^0^1^0^1^0^0^1^"
End DoDot:1
QUIT
+48 IF TYPE=5
Begin DoDot:1
+49 SET CNT=CNT+1
SET RESULT(CNT)="PLACEMENT IEN^Last Placement^ptLabel^0^0^2^0^1^0^1^1^"
+50 SET CNT=CNT+1
SET RESULT(CNT)="READING^Measurements^ptCBO^0^1^1^0^1^0^1^1^"
+51 SET CNT=CNT+1
SET RESULT(CNT)="RESULTS^Interpretation^ptCBO^1^1^1^0^1^0^1^1^"
+52 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateTime^0^2^1^0^1^0^1^1^"
+53 SET CNT=CNT+1
SET RESULT(CNT)="ENCOUNTER PROVIDER^Read By^ptCBOLongList^1^2^1^0^1^0^1^1^"
+54 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^2^0^0^0^1^1^"
End DoDot:1
QUIT
+55 QUIT
+56 ;
BLDLAYOT(RESULTS,INPUTS,TYPE) ;
+1 NEW CNT,DATA,DATA1,DATA2,EXT,INT,NAME,NODE,LAYOUT,PARM,PARR,PIECE,PRMPTS,TEMP,X
+2 SET DATA=$GET(INPUTS(1))
SET DATA1=$GET(INPUTS(2))
SET DATA2=$GET(INPUTS(3))
+3 DO LAYOUT(TYPE,.LAYOUT)
+4 DO BLDPRMPT^ORFEDT(.PRMPTS)
+5 DO BLDPARR^ORFEDT(.PARR)
+6 SET X=0
SET CNT=0
FOR
SET X=$ORDER(LAYOUT(X))
if X'>0
QUIT
Begin DoDot:1
+7 SET NODE=$GET(LAYOUT(X))
+8 SET NAME=$PIECE(NODE,U)
+9 SET INT=""
SET EXT=""
+10 SET PARM=$GET(PARR(NAME))
IF PARM=""
QUIT
+11 SET PIECE=+PRMPTS(PARM)
IF PIECE=0
QUIT
+12 SET TEMP=$PIECE(DATA,U,PIECE)
+13 IF PARM="pnumImmRoute"
SET EXT=$PIECE(TEMP,";")
SET INT=$PIECE(TEMP,";",3)
+14 IF PARM="pnumImmSite"
SET EXT=$PIECE(TEMP,";")
SET INT=$PIECE(TEMP,";",3)
+15 IF PARM="pnumImmLot"
SET EXT=$PIECE(TEMP,";")
SET INT=$PIECE(TEMP,";",2)
+16 IF PARM="pnumImmManufacturer"
SET EXT=TEMP
+17 IF PARM="pnumExpirationDate"
SET INT=TEMP
IF +INT>0
SET EXT=$$FMTE^XLFDT(INT)
+18 IF PARM="pnumImmDosage"
SET EXT=$PIECE(TEMP,";")
SET INT=EXT
+19 IF PARM="pnumImmOrderByIEN"
SET INT=TEMP
IF INT>0
SET EXT=$$GET1^DIQ(200,INT_",",.01)
+20 IF PARM="pnumAdminByPolicy"
SET INT=TEMP
+21 IF PARM="pnumImmSeries"
SET INT=TEMP
+22 IF PARM="pnumProvider"
SET INT=TEMP
IF INT>0
SET EXT=$$GET1^DIQ(200,INT_",",.01)
+23 IF PARM="pnumComment"
SET TEMP=$PIECE(DATA1,U,3)
SET EXT=TEMP
SET INT=TEMP
+24 IF PARM="pnumImmOverride"
SET TEMP=$PIECE(DATA2,U,3)
SET EXT=TEMP
SET INT=TEMP
+25 IF PARM="pnumDataSource"
SET EXT=$PIECE(TEMP,";")
SET INT=$PIECE(TEMP,";",2)
+26 IF PARM="pnumIMMVIS"
SET INT=$$VIS(TEMP)
+27 IF PARM="pnumImmContra"
SET INT=+$PIECE(DATA,U,2)
SET EXT=$PIECE(DATA,U,4)
+28 IF PARM="pnumWarnDate"
Begin DoDot:2
+29 SET INT=TEMP
+30 SET CNT=CNT+1
+31 SET RESULTS(CNT)="STOP"_U_$SELECT(INT>1:0_U_"No",1:1_U_"Yes")
End DoDot:2
+32 IF PARM="pnumImmRefused"
SET INT=+$PIECE(DATA,U,2)
SET EXT=$PIECE(DATA,U,4)
+33 IF PARM="pnumAdminDate"
SET INT=TEMP
SET EXT=TEMP
+34 ;S INT='$P(DATA,U,9)
IF PARM="pnumRefusedGroup"
SET INT=TEMP
+35 IF INT="@"
SET INT=""
+36 IF EXT="@"
SET EXT=""
+37 SET CNT=CNT+1
SET RESULTS(CNT)=NAME_U_INT_U_EXT
End DoDot:1
+38 QUIT
+39 ;
GET(RESULT,DATAARR,DEFAULTS) ;
+1 NEW ADMINBY,CNT,DATETIME,ENCTYPE,ERRMSG,FROMCVR,HASDEF,ID,IDX,LAYOUT,LOC,LOCLIST,NAME
+2 NEW NEEDOVER,NODE,ORDERBY,PAT,PARR,PRMPTS,SERMAX,SERREQ,TEMP,TYPE,VIMMDOC,VSTSTR
+3 SET HASDEF=$SELECT($DATA(DEFAULTS):1,1:0)
+4 SET ID=DATAARR("ID")
SET NAME=DATAARR("NAME")
SET TYPE=DATAARR("DOCUMENTTYPE")
SET DATETIME=DATAARR("DATETIME")
SET NEEDOVER=DATAARR("NEEDSOVERRIDE")
+5 SET VSTSTR=DATAARR("VISITSTR")
SET LOC=$PIECE(VSTSTR,";")
+6 SET VIMMDOC=$SELECT($DATA(DATAARR("VIMMTYPE")):$GET(DATAARR("VIMMTYPE")),1:"")
+7 SET FROMCVR=+$GET(DATAARR("FROMCOVER"))
+8 SET PAT=$GET(DATAARR("PATIENTID"))
+9 SET ENCTYPE=$GET(DATAARR("ENCOUNTERTYPE"))
+10 SET ADMINBY=$GET(DATAARR("USERIEN"))_U_$GET(DATAARR("USERNAME"))
+11 SET ORDERBY=$GET(DATAARR("ENCOUNTERPROVIDERIEN"))_U_$GET(DATAARR("ENCOUNTERPROVIDERNAME"))
+12 SET CNT=0
SET SERREQ=0
SET SERMAX=0
+13 SET ERRMSG=""
+14 IF TYPE=0
IF FROMCVR=1
SET ERRMSG=$$REMONLY(ID,TYPE)
+15 IF ERRMSG'=""
SET RESULT(0)=-1_U_ERRMSG
+16 DO BLDPRMPT^ORFEDT(.PRMPTS)
+17 DO BLDPARR^ORFEDT(.PARR)
+18 DO GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PAT,.CNT,.RESULT,.DEFAULTS,.SERMAX,.SERREQ,.LOCLIST)
+19 IF '$DATA(DEFAULTS("ENCOUNTER PROVIDER"))
SET DEFAULTS("ENCOUNTER PROVIDER")=ADMINBY
+20 IF '$DATA(DEFAULTS("ORDERING PROVIDER"))
SET DEFAULTS("ORDERING PROVIDER")=ORDERBY
+21 DO LAYOUT(TYPE,.LAYOUT)
+22 IF TYPE=0
Begin DoDot:1
+23 IF $GET(DEFAULTS("OVERRIDE REASON"))=""
IF NEEDOVER
SET DEFAULTS("OVERRIDE REASON")=""
+24 SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^4^6"
End DoDot:1
+25 IF TYPE=1
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^4^4"
+26 IF TYPE=2
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^3^2"
+27 IF TYPE=3
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^3^3"
+28 IF TYPE=4
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^1^1"
+29 IF TYPE=5
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^2^4"
+30 SET IDX=0
FOR
SET IDX=$ORDER(LAYOUT(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+31 SET NODE=LAYOUT(IDX)
+32 IF $PIECE(NODE,U)="SERIES"
IF TYPE=0
Begin DoDot:2
+33 IF SERREQ=1
SET $PIECE(NODE,U,8)=1
+34 IF SERMAX>0
SET $PIECE(NODE,U,9)=1
End DoDot:2
+35 IF $PIECE(NODE,U)="CVXONLY"
SET $PIECE(NODE,U,2)=$PIECE(NODE,U,2)_NAME
+36 IF $PIECE(NODE,U)="ADMIN SITE"
IF $DATA(LOCLIST)>1
SET $PIECE(NODE,U,9)=1
+37 IF $PIECE(NODE,U)="ORDERING PROVIDER"
IF +$$GETDEF("ORDERED BY POLICY",TYPE,.DEFAULTS)
SET $PIECE(NODE,U,11)=0
+38 IF $PIECE(NODE,U)="DOSE"
IF HASDEF=1
IF $GET(DEFAULTS("DOSE UNIT"))'=""
IF $PIECE(DEFAULTS("DOSE UNIT"),U)'="mL"
IF DEFAULTS("COMMENTS")["Dosage:"
Begin DoDot:2
+39 SET $PIECE(NODE,U,10)=0
End DoDot:2
+40 SET TEMP=$$GETDEF($PIECE(NODE,U),TYPE,.DEFAULTS)
+41 SET CNT=CNT+1
SET RESULT(CNT)=NODE_TEMP
+42 IF $PIECE(NODE,U)="DOSE"
IF $PIECE($GET(DEFAULTS("DOSE UNIT")),U)'=""
SET $PIECE(RESULT(CNT),U,2)="Dosage in "_$PIECE(DEFAULTS("DOSE UNIT"),U)
End DoDot:1
+43 QUIT
+44 ;
GETDEF(NAME,TYPE,DEFAULT) ;
+1 NEW CNT,EXT,INT,RESULT,TEMP
+2 SET RESULT=""
+3 IF '$DATA(DEFAULT(NAME))
Begin DoDot:1
+4 IF NAME'["CODES"
SET RESULT=U
+5 IF NAME="OVERRIDE REASON"
SET RESULT=0_U_1_U
QUIT
+6 IF RESULT'=""
QUIT
+7 SET RESULT=1_U_1_U_U
End DoDot:1
QUIT RESULT
+8 IF NAME="VIS OFFERED"
Begin DoDot:1
+9 IF $DATA(DEFAULT(NAME))=1
SET RESULT=DEFAULT(NAME)
QUIT
+10 SET INT=""
SET EXT=""
+11 SET CNT=0
FOR
SET CNT=$ORDER(DEFAULT(NAME,CNT))
if CNT'>0
QUIT
Begin DoDot:2
+12 SET TEMP=$GET(DEFAULT(NAME,CNT))
IF TEMP=""
QUIT
+13 SET INT=$SELECT(INT'="":";"_$PIECE(TEMP,U),1:$PIECE(TEMP,U))
+14 SET EXT=$SELECT(EXT'="":";"_$PIECE(TEMP,U),1:$PIECE(TEMP,U))
End DoDot:2
+15 SET RESULT=INT_U_EXT
End DoDot:1
QUIT RESULT
+16 IF NAME="OVERRIDE REASON"
Begin DoDot:1
+17 SET TEMP=DEFAULT("OVERRIDE REASON")
+18 IF NEEDOVER=1
SET RESULT=1_U_1_U_TEMP
End DoDot:1
QUIT RESULT
+19 IF NAME="GRPLIST"
Begin DoDot:1
+20 IF DEFAULT("GRPLIST")="NONE"
SET RESULT=0_U
QUIT
+21 SET RESULT=1_U
End DoDot:1
QUIT RESULT
+22 IF NAME="CVXONLY"
Begin DoDot:1
+23 SET RESULT=$SELECT(DEFAULT("GRPLIST")="NONE":0,1:1)_U_1_U
+24 SET RESULT=RESULT_$GET(DEFAULT("CVXONLY"))
End DoDot:1
QUIT RESULT
+25 ;.I +$$GETDEF("ORDERED BY POLICY",TYPE,.DEFAULTS) S RESULT=U Q
+26 ;.S RESULT=ENCOPIEN_U_ENCOPNAM Q
+27 SET RESULT=$GET(DEFAULT(NAME))
+28 IF RESULT=""
SET RESULT=U
+29 QUIT RESULT
+30 ;
GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PAT,CNT,RESULT,DEFAULTS,SERMAX,SERREQ,LOCLIST) ;
+1 NEW NOTEARR,TEMP,X
+2 IF TYPE=0
Begin DoDot:1
+3 ;S CODECNT=0
+4 DO GETDETLS^ORFIMM2(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE,LOC,.SERREQ,.SERMAX)
+5 DO GETROUTE^ORFIMM1(.RESULT,.CNT,.DEFAULTS,.LOCLIST)
+6 DO GETSITE(.RESULT,.CNT,.DEFAULTS,.LOCLIST)
+7 DO GETSERS(.RESULT,.CNT,.DEFAULTS,SERREQ,SERMAX)
End DoDot:1
QUIT
+8 IF TYPE=1
Begin DoDot:1
+9 DO GETINFO(.RESULT,.CNT,.DEFAULTS)
+10 DO GETSITE(.RESULT,.CNT,.DEFAULTS)
+11 DO GETROUTE^ORFIMM1(.RESULT,.CNT,.DEFAULTS)
+12 DO GETSERS(.RESULT,.CNT,.DEFAULTS,SERREQ,SERMAX)
+13 DO GETMANF(.RESULT,.CNT,.DEFAULTS)
+14 DO GETLOC(.RESULT,.CNT,.DEFAULTS)
+15 DO GETDLOC(.RESULT,.CNT,.DEFAULTS)
End DoDot:1
QUIT
+16 IF TYPE=2
Begin DoDot:1
+17 DO GETCONT(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE,$GET(LOC))
+18 DO GETSTOP^ORFIMM1(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
End DoDot:1
QUIT
+19 IF TYPE=3
Begin DoDot:1
+20 DO GETREFUS(.RESULT,.CNT,.DEFAULTS,LOC)
+21 DO GETSTOP^ORFIMM1(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
+22 DO GETGROUP(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
+23 DO GETCVX(.RESULT,.CNT,.DEFAULTS,ID,DATETIME,ENCTYPE)
End DoDot:1
QUIT
+24 IF TYPE=4
Begin DoDot:1
+25 SET TEMP=$SELECT(VIMMDOC["Admin":0,VIMMDOC["Hist":1,VIMMDOC["Contr":2,VIMMDOC["Ref":3,1:-1)
+26 DO GETTEXT^ORFIMM1(.NOTEARR,.DEFAULTS,ID,NAME,TEMP,DATETIME,LOC,1)
+27 SET X=0
FOR
SET X=$ORDER(NOTEARR(X))
if X'>0
QUIT
Begin DoDot:2
+28 SET CNT=CNT+1
SET RESULT(CNT)="DATA WORD PROCESSING"_U_"DISPLAY"_U_NOTEARR(X)
End DoDot:2
End DoDot:1
QUIT
+29 IF TYPE=5
Begin DoDot:1
+30 DO GETREAD(.RESULT,.CNT,.DEFAULTS,PAT)
+31 IF "AID"[ENCTYPE
SET DEFAULTS("VISIT DATE TIME")=U_DATETIME
+32 IF "AID"'[ENCTYPE
SET DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
End DoDot:1
+33 QUIT
+34 ;
GETREAD(RESULT,CNT,DEFAULTS,PAT) ;
+1 NEW ORARR,X,TEMP
+2 DO READENT^PXAPIIM(.ORARR,PAT)
+3 IF ORARR(1)=""
QUIT
+4 SET DEFAULTS("PLACEMENT IEN")=$PIECE(ORARR(1),U)_U_$PIECE(ORARR(1),U,2)_" placed on: "_$TRANSLATE($$FMTE^XLFDT($PIECE(ORARR(1),U,3),"2ZM"),"@"," ")
+5 KILL ORARR
DO READVALS^PXAPIIM(.ORARR)
+6 FOR X=$PIECE(ORARR("RANGE"),":"):1:$PIECE(ORARR("RANGE"),":",2)
SET CNT=CNT+1
SET RESULT(CNT)="DATA^READING"_U_X_U_X
+7 SET TEMP=""
FOR
SET TEMP=$ORDER(ORARR("CODES",TEMP))
if TEMP=""
QUIT
Begin DoDot:1
+8 SET CNT=CNT+1
SET RESULT(CNT)="DATA^RESULTS^"_$PIECE(TEMP,":")_U_$PIECE(TEMP,":",2)
End DoDot:1
+9 QUIT
+10 ;
GETSITE(RESULT,CNT,DEFAULT,LOCLIST) ;
+1 NEW DATALST,ID,X
+2 DO IMMSITE^PXVRPC2(.DATALST,"S:A")
+3 ;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"ADMIN SITE"_U_"NUMBER"_U_4
+4 SET X=0
FOR
SET X=$ORDER(DATALST(X))
if X'>0
QUIT
Begin DoDot:1
+5 IF DATALST(X)'[U
QUIT
+6 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"ADMIN SITE"_U_DATALST(X)
+7 IF $DATA(LOCLIST)>1
Begin DoDot:2
+8 SET ID=0
FOR
SET ID=$ORDER(LOCLIST(ID))
if ID'>0
QUIT
Begin DoDot:3
+9 IF ID'=+DATALST(X)
QUIT
+10 SET CNT=CNT+1
SET RESULT(CNT)="LINE"_U_"ADMIN SITE"_U_DATALST(X)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
GETSERS(RESULT,CNT,DEFAULT,SERREQ,SERMAX) ;
+1 NEW DATALST,X
+2 DO GETSET^ORWPCE2(.DATALST,9000010.11,.04,1)
+3 ;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"SERIES"_U_"NUMBER"_U_2
+4 SET X=""
FOR
SET X=$ORDER(DATALST(X))
if X=""
QUIT
Begin DoDot:1
+5 IF $PIECE(DATALST(X),U)="@"
IF SERREQ=1
QUIT
+6 IF SERMAX>0
IF +DATALST(X)>0
IF +DATALST(X)'>SERMAX
SET CNT=CNT+1
SET RESULT(CNT)="LINE"_U_"SERIES"_U_DATALST(X)
+7 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"SERIES"_U_DATALST(X)
End DoDot:1
+8 QUIT
+9 ;
GETINFO(RESULT,CNT,DEFAULTS) ;
+1 NEW DATALIST,ORNAME,ORNODE,X
+2 DO IMMSRC^PXVRPC2(.DATALIST,"S:AH")
+3 SET X=0
FOR
SET X=$ORDER(DATALIST(X))
if X'>0
QUIT
Begin DoDot:1
+4 SET ORNODE=$GET(DATALIST(X))
+5 SET ORNAME=$PIECE(ORNODE,U,2)
+6 IF ORNAME["-"
SET ORNAME=$$TRIM^XLFSTR($PIECE(ORNAME,"-",2))
+7 SET $PIECE(ORNODE,U,2)=ORNAME
+8 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"INFO SOURCE"_U_ORNODE
End DoDot:1
+9 QUIT
+10 ;
GETLOC(RESULT,CNT,DEFAULTS) ;
+1 NEW DATALIST,X
+2 DO HISTLOC^ORQQPX(.DATALIST)
+3 SET X=0
FOR
SET X=$ORDER(^TMP("OR",$JOB,"LOC",X))
if X'>0
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"LOCATION"_U_^TMP("OR",$JOB,"LOC",X)
End DoDot:1
+5 QUIT
+6 ;
GETDLOC(RESULT,CNT,DEFAULTS) ;
+1 NEW DATALIST,X
+2 DO GETDEFOL^ORQQPX(.DATALIST)
+3 SET X=0
FOR
SET X=$ORDER(DATALIST(X))
if X'>0
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
SET RESULT(CNT)="DATA DEFAULT"_U_"LOCATION"_U_DATALIST(X)
End DoDot:1
+5 QUIT
+6 ;
GETMANF(RESULT,CNT,DEFAULTS) ;
+1 NEW DATALIST,X
+2 DO IMAN^PXVRPC1(.DATALIST,"S:B","",1)
+3 ;S CNT=CNT+1,RESULT(CNT)="DATA"_U_"INFO SOURCE"_U_"NUMBER"_U_4
+4 SET X=0
FOR
SET X=$ORDER(^TMP("PXVLST",$JOB,X))
if X'>0
QUIT
Begin DoDot:1
+5 IF +$PIECE(^TMP("PXVLST",$JOB,X),U)=-1
QUIT
+6 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"MANUFACTURER"_U_^TMP("PXVLST",$JOB,X)
End DoDot:1
+7 QUIT
+8 ;
GETREFUS(RESULT,CNT,DEFAULTS,LOC) ;
+1 NEW DATALIST,X
+2 DO GETICR^PXVRPC5(.DATALIST,920.5,"S:A","",LOC)
+3 SET X=0
FOR
SET X=$ORDER(DATALIST(X))
if X'>0
QUIT
Begin DoDot:1
+4 SET $PIECE(DATALIST(X),U)=+$PIECE(DATALIST(X),U)
+5 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"REFUSAL"_U_DATALIST(X)
End DoDot:1
+6 QUIT
+7 ;
GETGROUP(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE) ;
+1 NEW GRP,IEN,OCNT,ORGRPS
+2 SET OCNT=CNT
+3 DO IMMGRP^PXAPIIM(.ORGRPS,ID)
+4 SET GRP=""
FOR
SET GRP=$ORDER(ORGRPS("VG",GRP))
if GRP=""
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(ORGRPS("VG",GRP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"GRPLIST"_U_IEN_U_ORGRPS("VG",GRP,IEN)
+7 ;S CNT=CNT+1,RESULT(CNT)="DATA WORD PROCESSING"_U_"GRPLIST"_U_ORGRPS("VG",GRP,IEN)
End DoDot:2
End DoDot:1
+8 IF OCNT=CNT
SET DEFAULTS("GRPLIST")="NONE"
QUIT
+9 SET DEFAULTS("GRPLIST")="POPULATED"
+10 QUIT
+11 ;
GETCVX(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE) ;
+1 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"CVXONLY"_U_0_U_"No (Refusal of all immunizations in this group)"
+2 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"CVXONLY"_U_1_U_"Yes (Refusal of only this specific formulation of vaccine)"
+3 IF $GET(DEFAULTS("CVXONLY"))=""
SET DEFAULTS("CVXONLY")=0_U_"No (Refusal of all immunizations in this group)"
+4 QUIT
+5 ;
GETCONT(RESULT,CNT,DEFAULTS,ID,DATETIME,ENCTYPE,LOC) ;
+1 NEW DATALST,NODE,X
+2 DO IMMRPC^PXVRPC4(.DATALST,ID,DATETIME,"L:"_$GET(LOC))
+3 SET X=0
FOR
SET X=$ORDER(^TMP("PXVIMMRPC",$JOB,X))
if X'>0
QUIT
Begin DoDot:1
+4 SET NODE=^TMP("PXVIMMRPC",$JOB,X)
+5 IF $PIECE(NODE,U)'="CONTRA"
QUIT
+6 SET $PIECE(NODE,U,3)=$SELECT($PIECE(NODE,U,7)="P":$PIECE(NODE,U,3)_" (PRECAUTION)",$PIECE(NODE,U,7)="C":$PIECE(NODE,U,3)_" (CONTRAINDICATED)",1:$PIECE(NODE,U,3))
+7 SET $PIECE(NODE,U,2)=+$PIECE(NODE,U,2)
+8 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_"CONTRAINDICATED"_U_$PIECE(NODE,U,2,$LENGTH(NODE,U))
End DoDot:1
+9 QUIT
+10 ;
REMONLY(ID,TYPE) ;
+1 NEW NAME,IDX,ORERR,ORVALUE,RESULT
+2 SET RESULT=""
+3 DO GETLST^XPAR(.ORVALUE,"ALL","OR IMM REMINDER DIALOG","I",.ORERR)
+4 SET IDX=0
FOR
SET IDX=$ORDER(ORVALUE(IDX))
if IDX'>0!(RESULT'="")
QUIT
Begin DoDot:1
+5 IF ORVALUE(IDX)=ID
Begin DoDot:2
+6 SET NAME=$PIECE($GET(^AUTTIMM(ID,0)),U)
SET RESULT=NAME_" administration can only be documented through a Reminder Dialog"
End DoDot:2
End DoDot:1
+7 QUIT RESULT
+8 ;
VIS(VALUE) ;
+1 NEW IMMVIS,IMMVISDT,IMMVISENTRY,PXSEQ,PXX,RESULT,X
+2 SET PXSEQ=0
SET RESULT=""
+3 FOR PXX=1:1:$LENGTH(VALUE,";")
Begin DoDot:1
+4 SET IMMVISENTRY=$$TRIM^XLFSTR($PIECE(VALUE,";",PXX))
+5 SET IMMVIS=$PIECE(IMMVISENTRY,"/",1)
+6 IF 'IMMVIS
QUIT
+7 SET RESULT=$SELECT(RESULT="":IMMVIS,1:RESULT_";"_IMMVIS)
End DoDot:1
+8 QUIT RESULT
