ORFSKT ;SLC/AGP - GENERIC EDIT SKIN TEST ;Dec 22, 2022@14:03:10
;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597**;Dec 17, 1997;Build 3
;
; Reference to SKLIST^PXVRPC8 in ICR #7286
; Reference to GETSKCD^PXVRPC8 in ICR #7286
; Reference to SKSITES^PXVRPC8 in ICR #7286
; Reference to VSKIN^PXPXRM in ICR #4250
; Reference to ^AUPNVSIT( in ICR #1990
; Reference to ^AUPNVSK( in ICR #2354
;
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)="ANATOMIC LOC^Anatomic Location^ptCBO^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Date placed^ptDateTime^1^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ENCOUNTER PROVIDER^Administered by^ptCBOLongList^0^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ORDERING PROVIDER^Ordered by^ptCBOLongList^1^1^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^2^0^0^0^1^1^"
I TYPE=1 D Q
.S CNT=CNT+1,RESULT(CNT)="PLACEMENT IEN^Last Placement^ptLabel^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateTime^1^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="READING^Reading in millimeters (mm)^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)="ENCOUNTER PROVIDER^Read By^ptCBOLongList^2^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^0^"
.S CNT=CNT+1,RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^3^0^0^0^1^1^"
I TYPE=2 D Q
.S CNT=CNT+1,RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateBox^0^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="LOCATION^Outside Location^ptCBO^1^0^1^0^0^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="ENCOUNTER PROVIDER^Documented By^ptCBOLongList^2^0^1^0^1^0^1^1^"
.S CNT=CNT+1,RESULT(CNT)="READING^Reading in millimeters (mm)^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)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^"
.;S CNT=CNT+1,RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^"
.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^"
Q
;
BLD(RESULTS,LIST,INPUTS) ;
N ADMINDATE,CAT,CNT,DATE,EXT,HASERR,I,ID,IDX,INT,NAME,NODE,NOTEARR,NOTEINP,PARM,PARR,PRMPTS,SKNAME,VIS,VISCNT
N PIECE,X,DELSTR,DELSTR1,DELSTR2,DELSTR3,PLACEIEN
N LOC,DATETIME,ENCTYPE,TYPE,VISITSTR
;
S ID=$G(INPUTS("ID")),SKNAME=$G(INPUTS("NAME"))
S TYPE=$G(INPUTS("DOCUMENTTYPE"))
S VISITSTR=$G(INPUTS("VISITSTR"))
S LOC=$P(VISITSTR,";"),DATETIME=$P(VISITSTR,";",2),ENCTYPE=$P(VISITSTR,";",3)
;
S DELSTR="SK+"_U_ID_U_U_SKNAME
;S DELSTR1="COM"_U_1_U_"@",$P(DELSTR,U,10)=1
;S DELSTR2="COM"_U_2_U_"@",$P(DELSTR,U,24)=2
S HASERR=0,CNT=0
S PLACEIEN=""
;
D BLDPRMPT^ORFEDT(.PRMPTS)
D BLDPARR^ORFEDT(.PARR)
;
S IDX=0 F S IDX=$O(LIST(IDX)) Q:IDX'>0!(HASERR=1) D
.S NODE=LIST(IDX)
.S NAME=$P(NODE,U),INT=$P(NODE,U,2),EXT=$P(NODE,U,3)
.S PARM=$G(PARR(NAME))
.I PARM="" Q
.I PARM="pnumComment",$L(NODE,"^")>3 D Q
..S RESULTS(CNT)="-1^Comment cannot contain a caret symbol"
..S HASERR=1
.I NAME="PLACEMENT IEN" S PLACEIEN=INT
.S PIECE=+$G(PRMPTS(PARM)) I PIECE=0 Q
.D BLDSTRS(.RESULTS,.CNT,PARM,EXT,INT,PIECE,ID,SKNAME,TYPE,DATETIME,.DELSTR,.DELSTR1,.DELSTR2,.ADMINDATE,ENCTYPE,.PRMPTS,PLACEIEN)
.I $P($G(RESULTS(CNT)),U)=-1 S HASERR=1
;
I HASERR=1 Q
S CNT=0
S RESULTS(CNT)=1_U_$S(+$G(ADMINDATE)>0:ADMINDATE,1:DATETIME)
D GETTEXT(.NOTEARR,.LIST,ID,SKNAME,TYPE,DATETIME,LOC,0)
;
S I=0 F S I=$O(NOTEARR(I)) Q:I'>0 S CNT=CNT+1,RESULTS(CNT)="NOTE"_U_NOTEARR(I)
S CNT=CNT+1,RESULTS(CNT)="DATA"_U_DELSTR
S CNT=CNT+1,RESULTS(CNT)="DATA1"_U_$G(DELSTR1)
;S CNT=CNT+1,RESULTS(CNT)="DATA2"_U_$G(DELSTR2)
Q
;
BLDSTRS(RESULTS,CNT,PARM,EXT,INT,PIECE,ID,NAME,TYPE,DATETIME,DELSTR,DELSTR1,DELSTR2,ADMINDATE,ENCTYPE,PRMPTS,PLACEIEN) ;
N ORTEMP,ORDATEPLACED,ORPLACEVISIT
;
I PARM="pnumAdminDate" D Q
.S PIECE=+$G(PRMPTS(PARM))
.S ORTEMP=$S(TYPE=1:"Reading",1:"Administration")
.I INT>$$GETMAXDT^ORFIMM1() S RESULTS(CNT)="-1^"_ORTEMP_" Date/Time cannot be a future date/time." Q
.;
.; check if reading date/time is <= administration date/time
.I TYPE=1,$G(PLACEIEN) D
..S ORPLACEVISIT=$P($G(^AUPNVSK(PLACEIEN,0)),U,3)
..S ORDATEPLACED=$P($G(^AUPNVSK(PLACEIEN,12)),U,1)
..I ORDATEPLACED="" S ORDATEPLACED=$P($G(^AUPNVSIT(+ORPLACEVISIT,0)),U,1)
.I TYPE=1,$G(ORDATEPLACED),((INT<ORDATEPLACED)!(INT=ORDATEPLACED)) D Q
..S RESULTS(CNT)="-1^Reading Date/Time cannot be before or equal to the Administration date/time."
.;
.S ADMINDATE=INT
.I TYPE>0 S PIECE=8
.S $P(DELSTR,U,PIECE)=INT
;
I PARM="pnumImmOrderByIEN" S $P(DELSTR,U,PIECE)=INT Q
I PARM="pnumProvider" D Q
.I TYPE=1 S PIECE=11
.S $P(DELSTR,U,PIECE)=INT Q
I PARM="pnumComment",EXT'="" D Q
.I $L(EXT)>245 S RESULTS(CNT)="-1^Comment cannot exceed 245 characters" Q
.S DELSTR1="COM"_U_1_U_EXT
.I TYPE=1 S $P(DELSTR,U,14)=1 Q
.S $P(DELSTR,U,10)=1
;I PARM="pnumSkinResults" S $P(DELSTR,U,PIECE)=$S(INT="D":"Doubtful",1:EXT) Q
I PARM="pnumSkinResults" S $P(DELSTR,U,PIECE)=INT Q
I PARM="pnumSkinReading" S $P(DELSTR,U,PIECE)=EXT Q
I PARM="pnumImmSite" S $P(DELSTR,U,PIECE)=EXT_";;"_INT Q
I PARM="pnumReadingIEN" S $P(DELSTR,U,PIECE)=INT Q
Q
;
BLDLAYOT(RESULTS,INPUTS,TYPE) ;
N CNT,DATA,DATA1,DATA2,EXT,INT,NAME,NODE,LAYOUT,ORDATA,PARM,PARR,PRMPTS,PIECE,TEMP,X
S DATA=$G(INPUTS(1)),DATA1=$G(INPUTS(2))
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
.I PARM="pnumAdminDate" D
..I TYPE=1 S PIECE=8
..S INT=$P(DATA,U,PIECE),EXT=INT
.I PARM="pnumImmOrderByIEN" D
..S INT=+$P(DATA,U,PIECE)
..I INT>0 S EXT=$$GET1^DIQ(200,INT_",",.01)
.I PARM="pnumProvider" D
..I TYPE=1 S PIECE=11
..S INT=+$P(DATA,U,PIECE)
..I INT>0 S EXT=$$GET1^DIQ(200,INT_",",.01)
.I PARM="pnumComment" D
..S EXT=$P(DATA1,U,3)
..S:EXT="@" EXT="" S INT=EXT
.I PARM="pnumSkinResults" S INT=$P(DATA,U,PIECE)
.;.S EXT=$S(INT="D":"Unknown",1:TEMP)
.I PARM="pnumSkinReading" S EXT=$P(DATA,U,PIECE)
.I PARM="pnumImmSite" S TEMP=$P(DATA,U,PIECE) S EXT=$P(TEMP,";"),INT=$P(TEMP,";",3)
.I PARM="pnumReadingIEN" S INT=$P(DATA,U,PIECE) Q:INT'>0
.;.D VSKIN^PXPXRM(INT,.ORDATA)
.;.S EXT="Skin Test: "_$P(ORDATA("SKIN TEST"),U,2)_" placed on: "_$TR($$FMTE^XLFDT(ORDATA("D/T PLACEMENT RECORDED"),"2ZM"),"@"," ")
.S CNT=CNT+1,RESULTS(CNT)=NAME_U_INT_U_EXT
Q
;
CHKPLACE(PATIENT,ID) ;
N FOUND,I,ORARRAY
D SKLIST^PXVRPC8(.ORARRAY,PATIENT,ID,"",1)
S FOUND=0,I=0
F S I=$O(ORARRAY(I)) Q:I'>0!(FOUND=1) D
.I $P($G(ORARRAY(I)),U)="PLACEMENT" S FOUND=1
Q FOUND
;
GET(RESULT,DATAARR,DEFAULTS) ;
N ADMINBY,CNT,DATETIME,ENCTYPE,ID,LAYOUT,LOC,NAME,NEEDOVER,NODE,ORDERBY,PARR,PATIENT,PLACE,PRMPTS,TYPE,VIMMDOC,VSTSTR,X
S ID=DATAARR("ID"),NAME=DATAARR("NAME"),TYPE=DATAARR("DOCUMENTTYPE"),DATETIME=DATAARR("DATETIME"),PATIENT=DATAARR("PATIENTID")
S ENCTYPE=DATAARR("ENCOUNTERTYPE")
S VSTSTR=DATAARR("VISITSTR"),LOC=$P(VSTSTR,";")
S VIMMDOC=$S($D(DATAARR("VIMMTYPE")):$G(DATAARR("VIMMTYPE")),1:"")
S PLACE=$G(DATAARR("PLACEMENT IEN"))_U_$G(DATAARR("PLACEMENTTEST"))_U_$G(DATAARR("PLACEMENTNAME"))_U_$G(DATAARR("PLACEMENTDATE"))
S ADMINBY=$G(DATAARR("USERIEN"))_U_$G(DATAARR("USERNAME"))
S ORDERBY=$G(DATAARR("ENCOUNTERPROVIDERIEN"))_U_$G(DATAARR("ENCOUNTERPROVIDERNAME"))
S CNT=0
I TYPE=1,'$D(DEFAULTS),'$$CHKPLACE(PATIENT,ID) S RESULT(CNT)="-1^No Skin Test Placement on file" Q
D BLDPRMPT^ORFEDT(.PRMPTS)
D BLDPARR^ORFEDT(.PARR)
D GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PLACE,.CNT,.RESULT,.DEFAULTS,PATIENT)
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 S CNT=CNT+1,RESULT(CNT)="LAYOUT^2^4"
I TYPE=1 S CNT=CNT+1,RESULT(CNT)="LAYOUT^3^4"
I TYPE=2 S CNT=CNT+1,RESULT(CNT)="LAYOUT^3^3"
I TYPE=4 S CNT=CNT+1,RESULT(CNT)="LAYOUT^1^1"
S X=0 F S X=$O(LAYOUT(X)) Q:X'>0 D
.S NODE=LAYOUT(X)
.S CNT=CNT+1,RESULT(CNT)=NODE_$$GETDEF($P(NODE,U),TYPE,.DEFAULTS)
Q
;
GETCODES(RESULT,CNT,DEFAULTS,ID,TYPE,DATETIME) ;
N CODETEMP,CODECNT,CODEDCNT,CODETYPE,CPTTEMP,DXTEMP,DATALIST,NODE,X
S CODECNT=0,CODEDCNT=0
D GETSKCD^PXVRPC8(.DATALIST,ID,DATETIME)
S X=0 F S X=$O(DATALIST(X)) Q:X'>0 D
.S NODE=DATALIST(X)
.I TYPE=0,$P(NODE,U,5)="R" Q
.I TYPE=1,$P(NODE,U,5)="P" Q
.S CODETEMP=$P(NODE,U,2)_" ("_$P(NODE,U,4)_")"
.S CODETYPE=$S($P(NODE,U)["CPT":"CODES CPT",1:"CODES DX")
.I CODETYPE="CODES CPT" S CODECNT=CODECNT+1,CPTTEMP=$P(NODE,U,3)_U_CODETEMP
.I CODETYPE="CODES DX" S CODEDCNT=CODEDCNT+1,DXTEMP=$P(NODE,U,3)_U_CODETEMP
.S CNT=CNT+1,RESULT(CNT)="DATA"_U_CODETYPE_U_$P(NODE,U,3)_U_CODETEMP_U_$P(NODE,U,2)_U_$P(NODE,U,4)
I CODECNT=1 S DEFAULTS("CODES CPT")=0_U_1_U_CPTTEMP
I CODEDCNT=1 S DEFAULTS("CODES DX")=0_U_1_U_DXTEMP
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'="VISIT DATE TIME" S RESULT=U
.I RESULT'="" Q
.S RESULT=1_U_1_U_U
S RESULT=$G(DEFAULT(NAME))
I RESULT="" S RESULT=U
Q RESULT
;
GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PLACE,CNT,RESULT,DEFAULTS,PATIENT) ;
N CODECNT,NOTEARR,TEMP,X
I TYPE=0 D Q
.S CODECNT=0
.D GETSITE(.RESULT,.CNT,.DEFAULTS)
.I "AID"[ENCTYPE,'$D(DEFAULTS("VISIT DATE TIME")) D
..S DEFAULTS("VISIT DATE TIME")=U_DATETIME
..I DATETIME>$$GETMAXDT^ORFIMM1() S DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
.I "AID"'[ENCTYPE,'$D(DEFAULTS("VISIT DATE TIME")) S DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
.D GETCODES(.RESULT,.CNT,.DEFAULTS,ID,TYPE,$P(DEFAULTS("VISIT DATE TIME"),U,2))
I TYPE=1 D Q
.D GETMEAS(.RESULT,.CNT,.DEFAULTS)
.D GETINTP(.RESULT,.CNT,.DEFAULTS)
.D GETDATE(.DEFAULTS,ID,PATIENT,PLACE)
.I "AID"[ENCTYPE,'$D(DEFAULTS("VISIT DATE TIME")) D
..S DEFAULTS("VISIT DATE TIME")=U_DATETIME
..I DATETIME>$$GETMAXDT^ORFIMM1() S DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
.I "AID"'[ENCTYPE,'$D(DEFAULTS("VISIT DATE TIME")) S DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
.D GETCODES(.RESULT,.CNT,.DEFAULTS,ID,TYPE,$P(DEFAULTS("VISIT DATE TIME"),U,2))
I TYPE=2 D Q
.D GETMEAS(.RESULT,.CNT,.DEFAULTS)
.D GETINTP(.RESULT,.CNT,.DEFAULTS)
.D GETLOC(.RESULT,.CNT,.DEFAULTS)
.I '$D(DEFAULTS("VISIT DATE TIME")) S DEFAULTS("VISIT DATE TIME")=U
I TYPE=4 D Q
.S TEMP=$S(VIMMDOC["Admin":0,VIMMDOC["Read":1,VIMMDOC["Hist":2,1:-1)
.D GETTEXT(.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)
Q
;
GETSITE(RESULT,CNT,DEFAULTS) ;
N DATALIST,X
D SKSITES^PXVRPC8(.DATALIST)
S X=0 F S X=$O(DATALIST(X)) Q:X'>0 D
.S CNT=CNT+1,RESULT(CNT)="DATA^ANATOMIC LOC"_U_DATALIST(X)
Q
;
GETMEAS(RESULT,CNT,DEFAULTS) ;
N X
F X=0:1:50 S CNT=CNT+1,RESULT(CNT)="DATA^READING"_U_X_U_X
Q
;
GETINTP(RESULT,CNT,DEFAULTS) ;
S CNT=CNT+1,RESULT(CNT)="DATA^RESULTS^P^Positive"
S CNT=CNT+1,RESULT(CNT)="DATA^RESULTS^N^Negative"
S CNT=CNT+1,RESULT(CNT)="DATA^RESULTS^D^Unknown"
Q
;
GETDATE(DEFAULT,ID,PATIENT,NODE) ;
;N DATALIST,TEMP,X
N ORDATA,TEMP
;D SKLIST^PXVRPC8(.DATALIST,PATIENT,ID,"",1)
;S TEMP=""
;S X=0 F S X=$O(DATALIST(X)) Q:X'>0!(TEMP'="") D
;.S NODE=$G(DATALIST(X)) Q:NODE="" Q:$P(NODE,U)'="PLACEMENT"
I $P($G(DEFAULT("PLACEMENT IEN")),U)>0,$P(NODE,U,3)="" D Q
.D VSKIN^PXPXRM($P($G(DEFAULT("PLACEMENT IEN")),U),.ORDATA)
.S TEMP="Skin Test: "_$P(ORDATA("SKIN TEST"),U,2)_" placed on: "_$TR($$FMTE^XLFDT(ORDATA("D/T PLACEMENT RECORDED"),"2ZM"),"@"," ")
.S DEFAULT("PLACEMENT IEN")=$P($G(DEFAULT("PLACEMENT IEN")),U)_U_TEMP
S TEMP="Skin Test: "_$P(NODE,U,3)_" placed on: "_$TR($$FMTE^XLFDT($P(NODE,U,4),"2ZM"),"@"," ")
S DEFAULT("PLACEMENT IEN")=$P(NODE,U)_U_TEMP
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
;
GETTEXT(OUTPUT,LIST,ID,NAME,TYPE,DATETIME,LOC,FORMAT) ;
;scheduling ICR 10040
N I,J,NODE,TEMP,TEMPARR,XLOC,VISCNT
I FORMAT=0 D BLDDEFLS^ORFEDT(.LIST,.TEMPARR)
I FORMAT=1 M TEMPARR=LIST
S I=0
;determine label depending on admin vs historical
S I=I+1,OUTPUT(I)="Skin Test: "_NAME
S TEMP=$S(TYPE=2:"Historical Date Read On",TYPE=0:"Date Administered",1:"Read on")
S TEMP=TEMP_": "_$TR($$FMTE^XLFDT($P($G(TEMPARR("VISIT DATE TIME")),U,2),"2ZM"),"@"," ")
S I=I+1,OUTPUT(I)=TEMP
;
I $P($G(TEMPARR("ANATOMIC LOC")),U,2)'="" S I=I+1,OUTPUT(I)="Site: "_$P($G(TEMPARR("ANATOMIC LOC")),U,2)
;I $P($G(TEMPARR("ADMIN SITE")),U,2)'="" S I=I+1,OUTPUT(I)="Site: "_$P($G(TEMPARR("ADMIN SITE")),U,2)
S XLOC=""
I +LOC=LOC S LOC=$$GET1^DIQ(44,LOC,.01)
I TYPE["Hist",$P($G(TEMPARR("LOCATION")),U,2)="" S TEMP="Outside Location: " S XLOC=$P($G(TEMPARR("LOCATION")),U,2)
I TYPE["Ad" S TEMP="Location: ",XLOC=LOC
S TEMP=TEMP_XLOC
I XLOC'="" S I=I+1,OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
I $P($G(TEMPARR("ORDERING PROVIDER")),U,2)'="" S I=I+1,OUTPUT(I)="Order By: "_$P(TEMPARR("ORDERING PROVIDER"),U,2)
S I=I+1,OUTPUT(I)=$S(TYPE=2:"Documented By: ",TYPE=0:"Administered by: ",1:"Read By: ")_$P($G(TEMPARR("ENCOUNTER PROVIDER")),U,2)
I $P($G(TEMPARR("READING")),U,2)'="" S I=I+1,OUTPUT(I)="Reading: "_$P($G(TEMPARR("READING")),U,2)_" mm"
I $P($G(TEMPARR("RESULTS")),U,2)'="" S I=I+1,OUTPUT(I)="Interpretation: "_$P($G(TEMPARR("RESULTS")),U,2)
I $P($G(TEMPARR("COMMENTS")),U,2)'="" D FORMAT^ORFIMM1(.OUTPUT,.I,$P(TEMPARR("COMMENTS"),U,2),"Comment: ")
Q
;
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)
. ;S IMMVISDT=$P(IMMVISENTRY,"/",2)
. ;I IMMVISDT S IMMVIS=IMMVIS_U_IMMVISDT
. ;S PXSEQ=PXSEQ+1
. ;S @ROOT@("VIS",PXSEQ,0)=IMMVIS
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORFSKT 14919 printed Nov 22, 2024@17:40:48 Page 2
ORFSKT ;SLC/AGP - GENERIC EDIT SKIN TEST ;Dec 22, 2022@14:03:10
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**405,597**;Dec 17, 1997;Build 3
+2 ;
+3 ; Reference to SKLIST^PXVRPC8 in ICR #7286
+4 ; Reference to GETSKCD^PXVRPC8 in ICR #7286
+5 ; Reference to SKSITES^PXVRPC8 in ICR #7286
+6 ; Reference to VSKIN^PXPXRM in ICR #4250
+7 ; Reference to ^AUPNVSIT( in ICR #1990
+8 ; Reference to ^AUPNVSK( in ICR #2354
+9 ;
+10 QUIT
+11 ;
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)="ANATOMIC LOC^Anatomic Location^ptCBO^0^0^1^0^1^0^1^1^"
+7 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Date placed^ptDateTime^1^0^1^0^1^0^1^1^"
+8 SET CNT=CNT+1
SET RESULT(CNT)="ENCOUNTER PROVIDER^Administered by^ptCBOLongList^0^1^1^0^1^0^1^1^"
+9 SET CNT=CNT+1
SET RESULT(CNT)="ORDERING PROVIDER^Ordered by^ptCBOLongList^1^1^1^0^1^0^1^1^"
+10 SET CNT=CNT+1
SET RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^0^"
+11 SET CNT=CNT+1
SET RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^0^"
+12 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^2^0^0^0^1^1^"
End DoDot:1
QUIT
+13 IF TYPE=1
Begin DoDot:1
+14 SET CNT=CNT+1
SET RESULT(CNT)="PLACEMENT IEN^Last Placement^ptLabel^0^0^1^0^1^0^1^1^"
+15 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateTime^1^0^1^0^1^0^1^1^"
+16 SET CNT=CNT+1
SET RESULT(CNT)="READING^Reading in millimeters (mm)^ptCBO^0^1^1^0^1^0^1^1^"
+17 SET CNT=CNT+1
SET RESULT(CNT)="RESULTS^Interpretation^ptCBO^1^1^1^0^1^0^1^1^"
+18 SET CNT=CNT+1
SET RESULT(CNT)="ENCOUNTER PROVIDER^Read By^ptCBOLongList^2^0^1^0^1^0^1^1^"
+19 SET CNT=CNT+1
SET RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^0^"
+20 SET CNT=CNT+1
SET RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^0^"
+21 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^3^3^0^0^0^1^1^"
End DoDot:1
QUIT
+22 IF TYPE=2
Begin DoDot:1
+23 SET CNT=CNT+1
SET RESULT(CNT)="VISIT DATE TIME^Read Date^ptDateBox^0^0^1^0^1^0^1^1^"
+24 SET CNT=CNT+1
SET RESULT(CNT)="LOCATION^Outside Location^ptCBO^1^0^1^0^0^0^1^1^"
+25 SET CNT=CNT+1
SET RESULT(CNT)="ENCOUNTER PROVIDER^Documented By^ptCBOLongList^2^0^1^0^1^0^1^1^"
+26 SET CNT=CNT+1
SET RESULT(CNT)="READING^Reading in millimeters (mm)^ptCBO^0^1^1^0^1^0^1^1^"
+27 SET CNT=CNT+1
SET RESULT(CNT)="RESULTS^Interpretation^ptCBO^1^1^1^0^1^0^1^1^"
+28 ;S CNT=CNT+1,RESULT(CNT)="CODES CPT^Procedure Codes^ptCBO^0^2^1^0^1^"
+29 ;S CNT=CNT+1,RESULT(CNT)="CODES DX^Diagnosis Codes^ptCBO^1^2^1^0^1^"
+30 SET CNT=CNT+1
SET RESULT(CNT)="COMMENTS^Comment^ptEdit^0^2^3^0^0^0^1^1^"
End DoDot:1
QUIT
+31 IF TYPE=4
Begin DoDot:1
+32 SET CNT=CNT+1
SET RESULT(CNT)="DISPLAY^Details^ptMemo^0^0^1^0^1^0^0^1^"
End DoDot:1
QUIT
+33 QUIT
+34 ;
BLD(RESULTS,LIST,INPUTS) ;
+1 NEW ADMINDATE,CAT,CNT,DATE,EXT,HASERR,I,ID,IDX,INT,NAME,NODE,NOTEARR,NOTEINP,PARM,PARR,PRMPTS,SKNAME,VIS,VISCNT
+2 NEW PIECE,X,DELSTR,DELSTR1,DELSTR2,DELSTR3,PLACEIEN
+3 NEW LOC,DATETIME,ENCTYPE,TYPE,VISITSTR
+4 ;
+5 SET ID=$GET(INPUTS("ID"))
SET SKNAME=$GET(INPUTS("NAME"))
+6 SET TYPE=$GET(INPUTS("DOCUMENTTYPE"))
+7 SET VISITSTR=$GET(INPUTS("VISITSTR"))
+8 SET LOC=$PIECE(VISITSTR,";")
SET DATETIME=$PIECE(VISITSTR,";",2)
SET ENCTYPE=$PIECE(VISITSTR,";",3)
+9 ;
+10 SET DELSTR="SK+"_U_ID_U_U_SKNAME
+11 ;S DELSTR1="COM"_U_1_U_"@",$P(DELSTR,U,10)=1
+12 ;S DELSTR2="COM"_U_2_U_"@",$P(DELSTR,U,24)=2
+13 SET HASERR=0
SET CNT=0
+14 SET PLACEIEN=""
+15 ;
+16 DO BLDPRMPT^ORFEDT(.PRMPTS)
+17 DO BLDPARR^ORFEDT(.PARR)
+18 ;
+19 SET IDX=0
FOR
SET IDX=$ORDER(LIST(IDX))
if IDX'>0!(HASERR=1)
QUIT
Begin DoDot:1
+20 SET NODE=LIST(IDX)
+21 SET NAME=$PIECE(NODE,U)
SET INT=$PIECE(NODE,U,2)
SET EXT=$PIECE(NODE,U,3)
+22 SET PARM=$GET(PARR(NAME))
+23 IF PARM=""
QUIT
+24 IF PARM="pnumComment"
IF $LENGTH(NODE,"^")>3
Begin DoDot:2
+25 SET RESULTS(CNT)="-1^Comment cannot contain a caret symbol"
+26 SET HASERR=1
End DoDot:2
QUIT
+27 IF NAME="PLACEMENT IEN"
SET PLACEIEN=INT
+28 SET PIECE=+$GET(PRMPTS(PARM))
IF PIECE=0
QUIT
+29 DO BLDSTRS(.RESULTS,.CNT,PARM,EXT,INT,PIECE,ID,SKNAME,TYPE,DATETIME,.DELSTR,.DELSTR1,.DELSTR2,.ADMINDATE,ENCTYPE,.PRMPTS,PLACEIEN)
+30 IF $PIECE($GET(RESULTS(CNT)),U)=-1
SET HASERR=1
End DoDot:1
+31 ;
+32 IF HASERR=1
QUIT
+33 SET CNT=0
+34 SET RESULTS(CNT)=1_U_$SELECT(+$GET(ADMINDATE)>0:ADMINDATE,1:DATETIME)
+35 DO GETTEXT(.NOTEARR,.LIST,ID,SKNAME,TYPE,DATETIME,LOC,0)
+36 ;
+37 SET I=0
FOR
SET I=$ORDER(NOTEARR(I))
if I'>0
QUIT
SET CNT=CNT+1
SET RESULTS(CNT)="NOTE"_U_NOTEARR(I)
+38 SET CNT=CNT+1
SET RESULTS(CNT)="DATA"_U_DELSTR
+39 SET CNT=CNT+1
SET RESULTS(CNT)="DATA1"_U_$GET(DELSTR1)
+40 ;S CNT=CNT+1,RESULTS(CNT)="DATA2"_U_$G(DELSTR2)
+41 QUIT
+42 ;
BLDSTRS(RESULTS,CNT,PARM,EXT,INT,PIECE,ID,NAME,TYPE,DATETIME,DELSTR,DELSTR1,DELSTR2,ADMINDATE,ENCTYPE,PRMPTS,PLACEIEN) ;
+1 NEW ORTEMP,ORDATEPLACED,ORPLACEVISIT
+2 ;
+3 IF PARM="pnumAdminDate"
Begin DoDot:1
+4 SET PIECE=+$GET(PRMPTS(PARM))
+5 SET ORTEMP=$SELECT(TYPE=1:"Reading",1:"Administration")
+6 IF INT>$$GETMAXDT^ORFIMM1()
SET RESULTS(CNT)="-1^"_ORTEMP_" Date/Time cannot be a future date/time."
QUIT
+7 ;
+8 ; check if reading date/time is <= administration date/time
+9 IF TYPE=1
IF $GET(PLACEIEN)
Begin DoDot:2
+10 SET ORPLACEVISIT=$PIECE($GET(^AUPNVSK(PLACEIEN,0)),U,3)
+11 SET ORDATEPLACED=$PIECE($GET(^AUPNVSK(PLACEIEN,12)),U,1)
+12 IF ORDATEPLACED=""
SET ORDATEPLACED=$PIECE($GET(^AUPNVSIT(+ORPLACEVISIT,0)),U,1)
End DoDot:2
+13 IF TYPE=1
IF $GET(ORDATEPLACED)
IF ((INT<ORDATEPLACED)!(INT=ORDATEPLACED))
Begin DoDot:2
+14 SET RESULTS(CNT)="-1^Reading Date/Time cannot be before or equal to the Administration date/time."
End DoDot:2
QUIT
+15 ;
+16 SET ADMINDATE=INT
+17 IF TYPE>0
SET PIECE=8
+18 SET $PIECE(DELSTR,U,PIECE)=INT
End DoDot:1
QUIT
+19 ;
+20 IF PARM="pnumImmOrderByIEN"
SET $PIECE(DELSTR,U,PIECE)=INT
QUIT
+21 IF PARM="pnumProvider"
Begin DoDot:1
+22 IF TYPE=1
SET PIECE=11
+23 SET $PIECE(DELSTR,U,PIECE)=INT
QUIT
End DoDot:1
QUIT
+24 IF PARM="pnumComment"
IF EXT'=""
Begin DoDot:1
+25 IF $LENGTH(EXT)>245
SET RESULTS(CNT)="-1^Comment cannot exceed 245 characters"
QUIT
+26 SET DELSTR1="COM"_U_1_U_EXT
+27 IF TYPE=1
SET $PIECE(DELSTR,U,14)=1
QUIT
+28 SET $PIECE(DELSTR,U,10)=1
End DoDot:1
QUIT
+29 ;I PARM="pnumSkinResults" S $P(DELSTR,U,PIECE)=$S(INT="D":"Doubtful",1:EXT) Q
+30 IF PARM="pnumSkinResults"
SET $PIECE(DELSTR,U,PIECE)=INT
QUIT
+31 IF PARM="pnumSkinReading"
SET $PIECE(DELSTR,U,PIECE)=EXT
QUIT
+32 IF PARM="pnumImmSite"
SET $PIECE(DELSTR,U,PIECE)=EXT_";;"_INT
QUIT
+33 IF PARM="pnumReadingIEN"
SET $PIECE(DELSTR,U,PIECE)=INT
QUIT
+34 QUIT
+35 ;
BLDLAYOT(RESULTS,INPUTS,TYPE) ;
+1 NEW CNT,DATA,DATA1,DATA2,EXT,INT,NAME,NODE,LAYOUT,ORDATA,PARM,PARR,PRMPTS,PIECE,TEMP,X
+2 SET DATA=$GET(INPUTS(1))
SET DATA1=$GET(INPUTS(2))
+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 IF PARM="pnumAdminDate"
Begin DoDot:2
+13 IF TYPE=1
SET PIECE=8
+14 SET INT=$PIECE(DATA,U,PIECE)
SET EXT=INT
End DoDot:2
+15 IF PARM="pnumImmOrderByIEN"
Begin DoDot:2
+16 SET INT=+$PIECE(DATA,U,PIECE)
+17 IF INT>0
SET EXT=$$GET1^DIQ(200,INT_",",.01)
End DoDot:2
+18 IF PARM="pnumProvider"
Begin DoDot:2
+19 IF TYPE=1
SET PIECE=11
+20 SET INT=+$PIECE(DATA,U,PIECE)
+21 IF INT>0
SET EXT=$$GET1^DIQ(200,INT_",",.01)
End DoDot:2
+22 IF PARM="pnumComment"
Begin DoDot:2
+23 SET EXT=$PIECE(DATA1,U,3)
+24 if EXT="@"
SET EXT=""
SET INT=EXT
End DoDot:2
+25 IF PARM="pnumSkinResults"
SET INT=$PIECE(DATA,U,PIECE)
+26 ;.S EXT=$S(INT="D":"Unknown",1:TEMP)
+27 IF PARM="pnumSkinReading"
SET EXT=$PIECE(DATA,U,PIECE)
+28 IF PARM="pnumImmSite"
SET TEMP=$PIECE(DATA,U,PIECE)
SET EXT=$PIECE(TEMP,";")
SET INT=$PIECE(TEMP,";",3)
+29 IF PARM="pnumReadingIEN"
SET INT=$PIECE(DATA,U,PIECE)
if INT'>0
QUIT
+30 ;.D VSKIN^PXPXRM(INT,.ORDATA)
+31 ;.S EXT="Skin Test: "_$P(ORDATA("SKIN TEST"),U,2)_" placed on: "_$TR($$FMTE^XLFDT(ORDATA("D/T PLACEMENT RECORDED"),"2ZM"),"@"," ")
+32 SET CNT=CNT+1
SET RESULTS(CNT)=NAME_U_INT_U_EXT
End DoDot:1
+33 QUIT
+34 ;
CHKPLACE(PATIENT,ID) ;
+1 NEW FOUND,I,ORARRAY
+2 DO SKLIST^PXVRPC8(.ORARRAY,PATIENT,ID,"",1)
+3 SET FOUND=0
SET I=0
+4 FOR
SET I=$ORDER(ORARRAY(I))
if I'>0!(FOUND=1)
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(ORARRAY(I)),U)="PLACEMENT"
SET FOUND=1
End DoDot:1
+6 QUIT FOUND
+7 ;
GET(RESULT,DATAARR,DEFAULTS) ;
+1 NEW ADMINBY,CNT,DATETIME,ENCTYPE,ID,LAYOUT,LOC,NAME,NEEDOVER,NODE,ORDERBY,PARR,PATIENT,PLACE,PRMPTS,TYPE,VIMMDOC,VSTSTR,X
+2 SET ID=DATAARR("ID")
SET NAME=DATAARR("NAME")
SET TYPE=DATAARR("DOCUMENTTYPE")
SET DATETIME=DATAARR("DATETIME")
SET PATIENT=DATAARR("PATIENTID")
+3 SET ENCTYPE=DATAARR("ENCOUNTERTYPE")
+4 SET VSTSTR=DATAARR("VISITSTR")
SET LOC=$PIECE(VSTSTR,";")
+5 SET VIMMDOC=$SELECT($DATA(DATAARR("VIMMTYPE")):$GET(DATAARR("VIMMTYPE")),1:"")
+6 SET PLACE=$GET(DATAARR("PLACEMENT IEN"))_U_$GET(DATAARR("PLACEMENTTEST"))_U_$GET(DATAARR("PLACEMENTNAME"))_U_$GET(DATAARR("PLACEMENTDATE"))
+7 SET ADMINBY=$GET(DATAARR("USERIEN"))_U_$GET(DATAARR("USERNAME"))
+8 SET ORDERBY=$GET(DATAARR("ENCOUNTERPROVIDERIEN"))_U_$GET(DATAARR("ENCOUNTERPROVIDERNAME"))
+9 SET CNT=0
+10 IF TYPE=1
IF '$DATA(DEFAULTS)
IF '$$CHKPLACE(PATIENT,ID)
SET RESULT(CNT)="-1^No Skin Test Placement on file"
QUIT
+11 DO BLDPRMPT^ORFEDT(.PRMPTS)
+12 DO BLDPARR^ORFEDT(.PARR)
+13 DO GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PLACE,.CNT,.RESULT,.DEFAULTS,PATIENT)
+14 IF '$DATA(DEFAULTS("ENCOUNTER PROVIDER"))
SET DEFAULTS("ENCOUNTER PROVIDER")=ADMINBY
+15 IF '$DATA(DEFAULTS("ORDERING PROVIDER"))
SET DEFAULTS("ORDERING PROVIDER")=ORDERBY
+16 DO LAYOUT(TYPE,.LAYOUT)
+17 IF TYPE=0
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^2^4"
+18 IF TYPE=1
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^3^4"
+19 IF TYPE=2
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^3^3"
+20 IF TYPE=4
SET CNT=CNT+1
SET RESULT(CNT)="LAYOUT^1^1"
+21 SET X=0
FOR
SET X=$ORDER(LAYOUT(X))
if X'>0
QUIT
Begin DoDot:1
+22 SET NODE=LAYOUT(X)
+23 SET CNT=CNT+1
SET RESULT(CNT)=NODE_$$GETDEF($PIECE(NODE,U),TYPE,.DEFAULTS)
End DoDot:1
+24 QUIT
+25 ;
GETCODES(RESULT,CNT,DEFAULTS,ID,TYPE,DATETIME) ;
+1 NEW CODETEMP,CODECNT,CODEDCNT,CODETYPE,CPTTEMP,DXTEMP,DATALIST,NODE,X
+2 SET CODECNT=0
SET CODEDCNT=0
+3 DO GETSKCD^PXVRPC8(.DATALIST,ID,DATETIME)
+4 SET X=0
FOR
SET X=$ORDER(DATALIST(X))
if X'>0
QUIT
Begin DoDot:1
+5 SET NODE=DATALIST(X)
+6 IF TYPE=0
IF $PIECE(NODE,U,5)="R"
QUIT
+7 IF TYPE=1
IF $PIECE(NODE,U,5)="P"
QUIT
+8 SET CODETEMP=$PIECE(NODE,U,2)_" ("_$PIECE(NODE,U,4)_")"
+9 SET CODETYPE=$SELECT($PIECE(NODE,U)["CPT":"CODES CPT",1:"CODES DX")
+10 IF CODETYPE="CODES CPT"
SET CODECNT=CODECNT+1
SET CPTTEMP=$PIECE(NODE,U,3)_U_CODETEMP
+11 IF CODETYPE="CODES DX"
SET CODEDCNT=CODEDCNT+1
SET DXTEMP=$PIECE(NODE,U,3)_U_CODETEMP
+12 SET CNT=CNT+1
SET RESULT(CNT)="DATA"_U_CODETYPE_U_$PIECE(NODE,U,3)_U_CODETEMP_U_$PIECE(NODE,U,2)_U_$PIECE(NODE,U,4)
End DoDot:1
+13 IF CODECNT=1
SET DEFAULTS("CODES CPT")=0_U_1_U_CPTTEMP
+14 IF CODEDCNT=1
SET DEFAULTS("CODES DX")=0_U_1_U_DXTEMP
+15 QUIT
+16 ;
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'="VISIT DATE TIME"
SET RESULT=U
+6 IF RESULT'=""
QUIT
+7 SET RESULT=1_U_1_U_U
End DoDot:1
QUIT RESULT
+8 SET RESULT=$GET(DEFAULT(NAME))
+9 IF RESULT=""
SET RESULT=U
+10 QUIT RESULT
+11 ;
GETPOSS(ID,NAME,TYPE,DATETIME,ENCTYPE,LOC,VIMMDOC,PLACE,CNT,RESULT,DEFAULTS,PATIENT) ;
+1 NEW CODECNT,NOTEARR,TEMP,X
+2 IF TYPE=0
Begin DoDot:1
+3 SET CODECNT=0
+4 DO GETSITE(.RESULT,.CNT,.DEFAULTS)
+5 IF "AID"[ENCTYPE
IF '$DATA(DEFAULTS("VISIT DATE TIME"))
Begin DoDot:2
+6 SET DEFAULTS("VISIT DATE TIME")=U_DATETIME
+7 IF DATETIME>$$GETMAXDT^ORFIMM1()
SET DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
End DoDot:2
+8 IF "AID"'[ENCTYPE
IF '$DATA(DEFAULTS("VISIT DATE TIME"))
SET DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
+9 DO GETCODES(.RESULT,.CNT,.DEFAULTS,ID,TYPE,$PIECE(DEFAULTS("VISIT DATE TIME"),U,2))
End DoDot:1
QUIT
+10 IF TYPE=1
Begin DoDot:1
+11 DO GETMEAS(.RESULT,.CNT,.DEFAULTS)
+12 DO GETINTP(.RESULT,.CNT,.DEFAULTS)
+13 DO GETDATE(.DEFAULTS,ID,PATIENT,PLACE)
+14 IF "AID"[ENCTYPE
IF '$DATA(DEFAULTS("VISIT DATE TIME"))
Begin DoDot:2
+15 SET DEFAULTS("VISIT DATE TIME")=U_DATETIME
+16 IF DATETIME>$$GETMAXDT^ORFIMM1()
SET DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
End DoDot:2
+17 IF "AID"'[ENCTYPE
IF '$DATA(DEFAULTS("VISIT DATE TIME"))
SET DEFAULTS("VISIT DATE TIME")=U_$$NOW^XLFDT()
+18 DO GETCODES(.RESULT,.CNT,.DEFAULTS,ID,TYPE,$PIECE(DEFAULTS("VISIT DATE TIME"),U,2))
End DoDot:1
QUIT
+19 IF TYPE=2
Begin DoDot:1
+20 DO GETMEAS(.RESULT,.CNT,.DEFAULTS)
+21 DO GETINTP(.RESULT,.CNT,.DEFAULTS)
+22 DO GETLOC(.RESULT,.CNT,.DEFAULTS)
+23 IF '$DATA(DEFAULTS("VISIT DATE TIME"))
SET DEFAULTS("VISIT DATE TIME")=U
End DoDot:1
QUIT
+24 IF TYPE=4
Begin DoDot:1
+25 SET TEMP=$SELECT(VIMMDOC["Admin":0,VIMMDOC["Read":1,VIMMDOC["Hist":2,1:-1)
+26 DO GETTEXT(.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 QUIT
+30 ;
GETSITE(RESULT,CNT,DEFAULTS) ;
+1 NEW DATALIST,X
+2 DO SKSITES^PXVRPC8(.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^ANATOMIC LOC"_U_DATALIST(X)
End DoDot:1
+5 QUIT
+6 ;
GETMEAS(RESULT,CNT,DEFAULTS) ;
+1 NEW X
+2 FOR X=0:1:50
SET CNT=CNT+1
SET RESULT(CNT)="DATA^READING"_U_X_U_X
+3 QUIT
+4 ;
GETINTP(RESULT,CNT,DEFAULTS) ;
+1 SET CNT=CNT+1
SET RESULT(CNT)="DATA^RESULTS^P^Positive"
+2 SET CNT=CNT+1
SET RESULT(CNT)="DATA^RESULTS^N^Negative"
+3 SET CNT=CNT+1
SET RESULT(CNT)="DATA^RESULTS^D^Unknown"
+4 QUIT
+5 ;
GETDATE(DEFAULT,ID,PATIENT,NODE) ;
+1 ;N DATALIST,TEMP,X
+2 NEW ORDATA,TEMP
+3 ;D SKLIST^PXVRPC8(.DATALIST,PATIENT,ID,"",1)
+4 ;S TEMP=""
+5 ;S X=0 F S X=$O(DATALIST(X)) Q:X'>0!(TEMP'="") D
+6 ;.S NODE=$G(DATALIST(X)) Q:NODE="" Q:$P(NODE,U)'="PLACEMENT"
+7 IF $PIECE($GET(DEFAULT("PLACEMENT IEN")),U)>0
IF $PIECE(NODE,U,3)=""
Begin DoDot:1
+8 DO VSKIN^PXPXRM($PIECE($GET(DEFAULT("PLACEMENT IEN")),U),.ORDATA)
+9 SET TEMP="Skin Test: "_$PIECE(ORDATA("SKIN TEST"),U,2)_" placed on: "_$TRANSLATE($$FMTE^XLFDT(ORDATA("D/T PLACEMENT RECORDED"),"2ZM"),"@"," ")
+10 SET DEFAULT("PLACEMENT IEN")=$PIECE($GET(DEFAULT("PLACEMENT IEN")),U)_U_TEMP
End DoDot:1
QUIT
+11 SET TEMP="Skin Test: "_$PIECE(NODE,U,3)_" placed on: "_$TRANSLATE($$FMTE^XLFDT($PIECE(NODE,U,4),"2ZM"),"@"," ")
+12 SET DEFAULT("PLACEMENT IEN")=$PIECE(NODE,U)_U_TEMP
+13 QUIT
+14 ;
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 ;
GETTEXT(OUTPUT,LIST,ID,NAME,TYPE,DATETIME,LOC,FORMAT) ;
+1 ;scheduling ICR 10040
+2 NEW I,J,NODE,TEMP,TEMPARR,XLOC,VISCNT
+3 IF FORMAT=0
DO BLDDEFLS^ORFEDT(.LIST,.TEMPARR)
+4 IF FORMAT=1
MERGE TEMPARR=LIST
+5 SET I=0
+6 ;determine label depending on admin vs historical
+7 SET I=I+1
SET OUTPUT(I)="Skin Test: "_NAME
+8 SET TEMP=$SELECT(TYPE=2:"Historical Date Read On",TYPE=0:"Date Administered",1:"Read on")
+9 SET TEMP=TEMP_": "_$TRANSLATE($$FMTE^XLFDT($PIECE($GET(TEMPARR("VISIT DATE TIME")),U,2),"2ZM"),"@"," ")
+10 SET I=I+1
SET OUTPUT(I)=TEMP
+11 ;
+12 IF $PIECE($GET(TEMPARR("ANATOMIC LOC")),U,2)'=""
SET I=I+1
SET OUTPUT(I)="Site: "_$PIECE($GET(TEMPARR("ANATOMIC LOC")),U,2)
+13 ;I $P($G(TEMPARR("ADMIN SITE")),U,2)'="" S I=I+1,OUTPUT(I)="Site: "_$P($G(TEMPARR("ADMIN SITE")),U,2)
+14 SET XLOC=""
+15 IF +LOC=LOC
SET LOC=$$GET1^DIQ(44,LOC,.01)
+16 IF TYPE["Hist"
IF $PIECE($GET(TEMPARR("LOCATION")),U,2)=""
SET TEMP="Outside Location: "
SET XLOC=$PIECE($GET(TEMPARR("LOCATION")),U,2)
+17 IF TYPE["Ad"
SET TEMP="Location: "
SET XLOC=LOC
+18 SET TEMP=TEMP_XLOC
+19 IF XLOC'=""
SET I=I+1
SET OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
+20 IF $PIECE($GET(TEMPARR("ORDERING PROVIDER")),U,2)'=""
SET I=I+1
SET OUTPUT(I)="Order By: "_$PIECE(TEMPARR("ORDERING PROVIDER"),U,2)
+21 SET I=I+1
SET OUTPUT(I)=$SELECT(TYPE=2:"Documented By: ",TYPE=0:"Administered by: ",1:"Read By: ")_$PIECE($GET(TEMPARR("ENCOUNTER PROVIDER")),U,2)
+22 IF $PIECE($GET(TEMPARR("READING")),U,2)'=""
SET I=I+1
SET OUTPUT(I)="Reading: "_$PIECE($GET(TEMPARR("READING")),U,2)_" mm"
+23 IF $PIECE($GET(TEMPARR("RESULTS")),U,2)'=""
SET I=I+1
SET OUTPUT(I)="Interpretation: "_$PIECE($GET(TEMPARR("RESULTS")),U,2)
+24 IF $PIECE($GET(TEMPARR("COMMENTS")),U,2)'=""
DO FORMAT^ORFIMM1(.OUTPUT,.I,$PIECE(TEMPARR("COMMENTS"),U,2),"Comment: ")
+25 QUIT
+26 ;
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)
+8 ;S IMMVISDT=$P(IMMVISENTRY,"/",2)
+9 ;I IMMVISDT S IMMVIS=IMMVIS_U_IMMVISDT
+10 ;S PXSEQ=PXSEQ+1
+11 ;S @ROOT@("VIS",PXSEQ,0)=IMMVIS
End DoDot:1
+12 QUIT RESULT
