PXCEVIMM ;ISL/dee,SLC/ajb - Used to edit and display V IMMUNIZATION ;Oct 29, 2021@10:23:33
;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124,199,201,210,215,211,217**;Aug 12, 1996;Build 134
;;
Q
;
;Line with the line label "FORMAT"
;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
; 1 2 3 4 5
;
;Following lines:
;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
;The Display & Edit routines are for special cases.
; (The .01 field cannot have a special edit.)
;
FORMAT ;;Immunization~9000010.11~0,2,3,11,12,13,14,15,16,811,812~0~^AUPNVIMM
;;0~1~.01~Immunization: ~Immunization: ~~~~~B
;;13~1~1301~Information Source: ~Information Source: ~~~~~D
;;12~7~1207~Lot Number: ~Lot Number: ~$$DISPLN^PXCEVIMM~~~~D
;;12~22~1222~Ordered By Policy: ~Ordered By Policy: ~~~~~D
;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
;;0~4~.04~Series: ~Series: ~~~~~D
;;0~6~.06~Reaction: ~Reaction: ~~~~~D
;;0~7~.07~Repeat Contraindicated: ~Repeat Contraindicated: ~~ECONTRAI^PXCEVIMM~~~D
;;12~1~1201~Administered Date and Time: ~Administered Date and Time: ~~EVENTDT^PXCEVIMM(.PXCEAFTR)~~~D
;;12~20~1220~Warning Acknowledged: ~Warning Acknowledged: ~~~~~D
;;16~1~1601~Warning Override Reason: ~Warning Override Reason: ~~~~~D
;;13~12~1312~Dose: ~Dose: ~~~~~D
;;13~13~1313~Dose Units: ~Dose Units: ~~~~~D
;;13~2~1302~Route of Administration: ~Route of Administration: ~~~~~D
;;13~3~1303~Site of Administration (Body): ~Site of Administration (Body): ~~~~~D
;;2~0~2~VIS Offered/Given: ~VIS: ~$$DISPVIS^PXCEVIS~EVIS^PXCEVIS~~~D
;;811~1~81101~Comments: ~Comments: ~~~~~D
;;812~2~81202~Package: ~Package: ~~SKIP^PXCEVIMM~~~D
;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCEVIMM~~~D
;;13~4~1304~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
;;3~2~.01~Other Diagnosis: ~Other Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
;;14~3~1403~Date and Time Read: ~Date/Time Read: ~~EREADDT^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
;;14~2~1402~Reading in Millimeters (mm): ~Reading in Millimeters (mm): ~~EREAD^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
;;14~1~1401~Results: ~Results: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
;;14~4~1404~Reader: ~Reader: ~~EPROV12^PXCEPRV~~~D
;;14~5~1405~Date and Time Reading Recorded: ~Reading Recorded: ~~SKIP^PXCEVIMM~~~D
;;14~6~1406~Hours Read Post-Inoculation: ~Hours Read Post-Inoculation: ~~SKIP^PXCEVIMM~~~D
;;15~1~1501~Reading Comments: ~Reading Comments: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
;;
;
;Cannot ask word processing
;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
;
;The interface for AICS to get list on form for help.
INTRFACE ;;PX SELECT IMMUNIZATIONS
;
;********************************
;Special cases for display.
;
;********************************
;Special cases for edit.
;
ECONTRAI ;
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
. S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
. S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
E S DIR("B")="NO"
S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
S DIR("A")=$P(PXCETEXT,"~",4)
S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
D ^DIR
K DIR,DA
I X="@" S Y="@"
E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
Q
;
EREAD(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading.
N DONE,READING
;If there is no reading date/time quit.
I $P(PXCEAFTR(14),U,3)="" Q
S DONE=0
F Q:DONE D
. D EREADDATA(DA,.PXCEAFTR,PXCETEXT)
. I PXCEEND=1 S DONE=1 Q
. S READING=$P(PXCEAFTR(14),U,2)
. I READING'="" S DONE=1 Q
Q
;
EREADDATA(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading data.
N DIR,FLDNUM,MSG,NODE,PIECE,PROMPT,X,Y
S NODE=$P(PXCETEXT,"~",1)
S PIECE=$P(PXCETEXT,"~",2)
S FLDNUM=$P(PXCETEXT,"~",3)
S PROMPT=$P(PXCETEXT,"~",4)
S DIR(0)=9000010.11_","_FLDNUM_"A"
S DIR("A")=PROMPT
S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
D ^DIR
;If any of the reading data is deleted, delete all of it.
I X="@" D Q
. S PXCEEND=1
. S PXCEAFTR(14)="",^AUPNVIMM(DA,14)=""
. S PXCEAFTR(15)="",^AUPNVIMM(DA,15)=""
I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
S $P(PXCEAFTR(NODE),U,PIECE)=$P(Y,U,1)
Q
;
EREADDT(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading date and time.
N ADMDT,DONE,HOURS,READDT
S ADMDT=$P(PXCEAFTR(12),U,1)
S DONE=0
F Q:DONE D
. D EREADDATA(DA,.PXCEAFTR,PXCETEXT)
. S READDT=$P(PXCEAFTR(14),U,3)
. I READDT="" S DONE=1 Q
. I READDT>ADMDT S DONE=1 Q
. D EN^DDIOL("Date/Time Read must be after the Administered Date/Time: "_$$FMTE^XLFDT(ADMDT))
I +READDT>0 D
. S HOURS=$$FMDIFF^XLFDT(READDT,ADMDT,2)\3600
. D EN^DDIOL("Hours Read Post-Inoculation: "_HOURS)
Q
;
ELOT ;
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
. S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
. S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
S DIR(0)="PAO^9999999.41:EM^K:$P(^(0),U,3)'=0!($P(^(0),U,4)'=$P(PXCEAFTR(0),U,1)) X"
S DIR("A")=$P(PXCETEXT,"~",4)
S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
D ^DIR
K DIR,DA
I X="@" S Y="@"
E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
S:Y'<0 $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
Q
;
EPOV ;Edit the Associated DX
;Not used, adding/editing diagnosis removed in PX*1.0*211
N PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
S PXDATE=$S($D(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$D(PXCEAPDT)=1:PXCEAPDT,1:DT)
S PXACSREC=$$ACTDT^PXDXUTL(PXDATE),PXACS=$P(PXACSREC,"^",3)
I PXACS["-" S PXACS=$P(PXACS,"-",1,2)
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
.N DIERR,PXCEDILF,PXCEINT,PXCEEXT
.S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
.S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
.S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
I $P(PXACSREC,U,1)'="ICD" D
. S PXDXASK=PXACS_" "_$P(PXCETEXT,"~",4)
. S PXDEF=$G(DIR("B")),PXAGAIN=0 D ^PXDSLK I PXXX=-1 S Y=-1 Q
. I PXXX="@" S Y="@" Q
. S Y=$P($$ICDDATA^ICDXCODE("DIAG",$P($P(PXXX,U,1),";",2),PXDATE,"E"),U,1)
I $P(PXACSREC,U,1)="ICD" D
. S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
. S DIR("A")=PXACS_" "_$P(PXCETEXT,"~",4)
. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
. D ^DIR
K DIR,DA
I X="@" S Y="@" S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^") Q
I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
I +Y'>0 S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".08" PXCEQUIT=1 Q
;See if this diagnosis is in the PXCEAFTR(0)
I $P(PXCETEXT,"~",2)'=1,(+Y=$P($G(PXCEAFTR(80)),"^",1)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=2,(+Y=$P($G(PXCEAFTR(80)),"^",2)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=3,(+Y=$P($G(PXCEAFTR(80)),"^",3)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=4,(+Y=$P($G(PXCEAFTR(80)),"^",4)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=5,(+Y=$P($G(PXCEAFTR(80)),"^",5)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=6,(+Y=$P($G(PXCEAFTR(80)),"^",6)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=7,(+Y=$P($G(PXCEAFTR(80)),"^",7)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=8,(+Y=$P($G(PXCEAFTR8(80)),"^",8)) S PXCEEND=1
;
; check for duplicate diagnosis in OTHER DIAGNOSIS
N DX D:+$G(PXCEFIEN)
. N CNT S CNT=0 F S CNT=$O(^AUPNVIMM(PXCEFIEN,3,CNT)) Q:'+CNT D
. . S DX(^AUPNVIMM(PXCEFIEN,3,CNT,0))=""
I +$D(DX(+Y)) S PXCEEND=1
;
I $G(PXCEEND)=1 W !,$C(7),"Duplicate Diagnosis is not allowed." D WAIT^PXCEHELP Q
S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
D:+Y>0 DIAGNOS^PXCEVFI4(+Y)
Q
;
EPOV2 ; edit OTHER DIAGNOSIS
;Not used, adding/editing diagnosis removed in PX*1.0*211
Q:'+$G(PXCEFIEN)
N PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
S PXDATE=$S($D(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$D(PXCEAPDT)=1:PXCEAPDT,1:DT)
S PXACSREC=$$ACTDT^PXDXUTL(PXDATE),PXACS=$P(PXACSREC,"^",3)
I PXACS["-" S PXACS=$P(PXACS,"-",1,2)
; get multiple diagnosis
N CNT,DX,DXS S CNT=0 F S CNT=$O(^AUPNVIMM(PXCEFIEN,3,CNT)) Q:'+CNT D
. S DX(CNT)=^AUPNVIMM(PXCEFIEN,3,CNT,0)
. S DXS(DX(CNT))=""
I '$D(DX) S DX(1)="" ; if no entries, show empty entry to allow adding
I $P(PXACSREC,U,1)="ICD" D
. N DIR S DIR(0)=PXCEFILE_"3,"_$P(PXCETEXT,"~",3)_"A"
. S DIR("A")=PXACS_" "_$P(PXCETEXT,"~",4)
. S CNT=0 F S CNT=$O(DX(CNT)) Q:'+CNT!($D(DTOUT)!($D(DUOUT))) D
. . N DA,X,Y
. . S DIR("B")=$$EXTERNAL^DILFD(PXCEFILE_3,".01","",DX(CNT),"PXCEDILF")
. . D ^DIR Q:$D(DTOUT)!$D(DUOUT) Q:X=""
. . I X="@" W ! I +$$READ("YE","Are you sure you want to remove this entry","NO") D DELDX(CNT) Q
. . I +$D(DXS(+Y)) W:Y(0)'=DIR("B") !!,$C(7),"Entry matches Other Diagnosis. Duplicate Diagnosis is not allowed." D:Y(0)'=DIR("B") WAIT^PXCEHELP Q ; quit if entry already exists
. . I +Y=$P($G(^AUPNVIMM(PXCEFIEN,13)),U,4) D Q ; quit if entry matches primary diagnosis
. . . W !!,$C(7),"Entry matches Primary Diagnosis. Duplicate Diagnosis is not allowed." D WAIT^PXCEHELP
. . I Y(0)'=DIR("B") D ; ask to overwrite or add new entry
. . . I DIR("B")'="" N ANS W ! S ANS=$$READ("SA^A:ADD;R:REPLACE","Do you want to ADD a new entry or REPLACE the current entry? ","ADD") W !
. . . I DIR("B")="" S ANS="A" ; if no current entry, always add
. . . I $P(ANS,U)="A"!($P(ANS,U)="R") D Q
. . . . N FDA,FDAIEN,ERRMSG,IEN
. . . . S IEN=$S($P(ANS,U)="A":"+1,"_PXCEFIEN_",",1:CNT_","_PXCEFIEN_",")
. . . . S FDA(PXCEFILE_3,IEN,.01)=+Y
. . . . D DIAGNOS^PXCEVFI4(+Y,1)
. . . . I '+$G(PXCEQUIT) D UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
Q
;
;********************************
EVENTDT(PXCEAFTR) ;Edit the Event Date and Time.
N DEFAULT,EVENTDT,HELP,IEN,PROMPT
S DEFAULT=$P(^TMP("PXK",$J,"IMM",1,12,"BEFORE"),U,1)
S HELP="D EVDTHELP^PXCEVIMM"
S PROMPT="Administered Date and Time"
S EVENTDT=$$GETDT^PXDATE(-1,-1,-1,DEFAULT,PROMPT,HELP)
S $P(PXCEAFTR(12),U,1)=EVENTDT
I $D(DUOUT)!$D(DTOUT) S PXCEEND=1 Q
Q
;
;********************************
EVDTHELP ;Event Date and Time help.
N ERR,RESULT,TEXT
S RESULT=$$GET1^DID(9000010.11,1201,"","DESCRIPTION","TEXT","ERR")
D BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V Immunization Administered Date and Time Help")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
;********************************
DELDX(DA) ; delete OTHER DIAGNOSIS
K DXS(DX(DA)),DX(DA)
S DA(1)=PXCEFIEN,DIK="^AUPNVIMM("_DA(1)_",3," D ^DIK W !!,"Entry successfully removed." D WAIT^PXCEHELP
Q
;
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
N DIR,X,Y,DUOUT,DTOUT,DIRUT S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
D ^DIR
I $G(X)="@" S Y="@" G READX
I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
READX Q Y
;
SKIP ;Used to by-pass roll and scroll editing of a field.
S (X,Y)=""
Q
;
;********************************
;Display text for the .01 field which is a pointer to Immunization.
;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEIMM,PXCEDT) ;
N DIERR,PXCEDILF,PXCEINT,PXCEEXT
S PXCEINT=$P(PXCEIMM,"^",1)
S PXCEEXT=$$EXTERNAL^DILFD(9000010.11,.01,"",PXCEINT,"PXCEDILF")
Q $S('$D(DIERR):PXCEEXT,1:PXCEINT)
;
DISPLN(PXCEINT,PCEDT) ; display lot number with manufacturer
N PXCEDILF,PXCEEXT,PXV2,PXVMAN
S PXCEEXT=$$EXTERNAL^DILFD(9000010.11,1207,"",PXCEINT,"PXCEDILF")
S PXV2=$P(^AUTTIML(PXCEINT,0),"^",2),PXVMAN=$$EXTERNAL^DILFD(9999999.41,.02,"",PXV2,"PXCEDILF")
Q $S('$D(DIERR):PXCEEXT_" "_PXVMAN,1:PXCEINT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVIMM 12372 printed Apr 09, 2024@21:29:05 Page 2
PXCEVIMM ;ISL/dee,SLC/ajb - Used to edit and display V IMMUNIZATION ;Oct 29, 2021@10:23:33
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124,199,201,210,215,211,217**;Aug 12, 1996;Build 134
+2 ;;
+3 QUIT
+4 ;
+5 ;Line with the line label "FORMAT"
+6 ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
+7 ; 1 2 3 4 5
+8 ;
+9 ;Following lines:
+10 ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
+11 ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
+12 ;The Display & Edit routines are for special cases.
+13 ; (The .01 field cannot have a special edit.)
+14 ;
FORMAT ;;Immunization~9000010.11~0,2,3,11,12,13,14,15,16,811,812~0~^AUPNVIMM
+1 ;;0~1~.01~Immunization: ~Immunization: ~~~~~B
+2 ;;13~1~1301~Information Source: ~Information Source: ~~~~~D
+3 ;;12~7~1207~Lot Number: ~Lot Number: ~$$DISPLN^PXCEVIMM~~~~D
+4 ;;12~22~1222~Ordered By Policy: ~Ordered By Policy: ~~~~~D
+5 ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
+6 ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
+7 ;;0~4~.04~Series: ~Series: ~~~~~D
+8 ;;0~6~.06~Reaction: ~Reaction: ~~~~~D
+9 ;;0~7~.07~Repeat Contraindicated: ~Repeat Contraindicated: ~~ECONTRAI^PXCEVIMM~~~D
+10 ;;12~1~1201~Administered Date and Time: ~Administered Date and Time: ~~EVENTDT^PXCEVIMM(.PXCEAFTR)~~~D
+11 ;;12~20~1220~Warning Acknowledged: ~Warning Acknowledged: ~~~~~D
+12 ;;16~1~1601~Warning Override Reason: ~Warning Override Reason: ~~~~~D
+13 ;;13~12~1312~Dose: ~Dose: ~~~~~D
+14 ;;13~13~1313~Dose Units: ~Dose Units: ~~~~~D
+15 ;;13~2~1302~Route of Administration: ~Route of Administration: ~~~~~D
+16 ;;13~3~1303~Site of Administration (Body): ~Site of Administration (Body): ~~~~~D
+17 ;;2~0~2~VIS Offered/Given: ~VIS: ~$$DISPVIS^PXCEVIS~EVIS^PXCEVIS~~~D
+18 ;;811~1~81101~Comments: ~Comments: ~~~~~D
+19 ;;812~2~81202~Package: ~Package: ~~SKIP^PXCEVIMM~~~D
+20 ;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCEVIMM~~~D
+21 ;;13~4~1304~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
+22 ;;3~2~.01~Other Diagnosis: ~Other Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
+23 ;;14~3~1403~Date and Time Read: ~Date/Time Read: ~~EREADDT^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
+24 ;;14~2~1402~Reading in Millimeters (mm): ~Reading in Millimeters (mm): ~~EREAD^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
+25 ;;14~1~1401~Results: ~Results: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
+26 ;;14~4~1404~Reader: ~Reader: ~~EPROV12^PXCEPRV~~~D
+27 ;;14~5~1405~Date and Time Reading Recorded: ~Reading Recorded: ~~SKIP^PXCEVIMM~~~D
+28 ;;14~6~1406~Hours Read Post-Inoculation: ~Hours Read Post-Inoculation: ~~SKIP^PXCEVIMM~~~D
+29 ;;15~1~1501~Reading Comments: ~Reading Comments: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
+30 ;;
+31 ;
+32 ;Cannot ask word processing
+33 ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
+34 ;
+35 ;The interface for AICS to get list on form for help.
INTRFACE ;;PX SELECT IMMUNIZATIONS
+1 ;
+2 ;********************************
+3 ;Special cases for display.
+4 ;
+5 ;********************************
+6 ;Special cases for edit.
+7 ;
ECONTRAI ;
+1 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))'=""
Begin DoDot:1
+2 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+3 SET PXCEINT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+4 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+5 SET DIR("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+6 IF '$TEST
SET DIR("B")="NO"
+7 SET DIR(0)=PXCEFILE_","_$PIECE(PXCETEXT,"~",3)_"A"
+8 SET DIR("A")=$PIECE(PXCETEXT,"~",4)
+9 if $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+10 DO ^DIR
+11 KILL DIR,DA
+12 IF X="@"
SET Y="@"
+13 IF '$TEST
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXCEEND=1
QUIT
+14 SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+15 QUIT
+16 ;
EREAD(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading.
+1 NEW DONE,READING
+2 ;If there is no reading date/time quit.
+3 IF $PIECE(PXCEAFTR(14),U,3)=""
QUIT
+4 SET DONE=0
+5 FOR
if DONE
QUIT
Begin DoDot:1
+6 DO EREADDATA(DA,.PXCEAFTR,PXCETEXT)
+7 IF PXCEEND=1
SET DONE=1
QUIT
+8 SET READING=$PIECE(PXCEAFTR(14),U,2)
+9 IF READING'=""
SET DONE=1
QUIT
End DoDot:1
+10 QUIT
+11 ;
EREADDATA(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading data.
+1 NEW DIR,FLDNUM,MSG,NODE,PIECE,PROMPT,X,Y
+2 SET NODE=$PIECE(PXCETEXT,"~",1)
+3 SET PIECE=$PIECE(PXCETEXT,"~",2)
+4 SET FLDNUM=$PIECE(PXCETEXT,"~",3)
+5 SET PROMPT=$PIECE(PXCETEXT,"~",4)
+6 SET DIR(0)=9000010.11_","_FLDNUM_"A"
+7 SET DIR("A")=PROMPT
+8 if $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+9 DO ^DIR
+10 ;If any of the reading data is deleted, delete all of it.
+11 IF X="@"
Begin DoDot:1
+12 SET PXCEEND=1
+13 SET PXCEAFTR(14)=""
SET ^AUPNVIMM(DA,14)=""
+14 SET PXCEAFTR(15)=""
SET ^AUPNVIMM(DA,15)=""
End DoDot:1
QUIT
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXCEEND=1
QUIT
+16 SET $PIECE(PXCEAFTR(NODE),U,PIECE)=$PIECE(Y,U,1)
+17 QUIT
+18 ;
EREADDT(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading date and time.
+1 NEW ADMDT,DONE,HOURS,READDT
+2 SET ADMDT=$PIECE(PXCEAFTR(12),U,1)
+3 SET DONE=0
+4 FOR
if DONE
QUIT
Begin DoDot:1
+5 DO EREADDATA(DA,.PXCEAFTR,PXCETEXT)
+6 SET READDT=$PIECE(PXCEAFTR(14),U,3)
+7 IF READDT=""
SET DONE=1
QUIT
+8 IF READDT>ADMDT
SET DONE=1
QUIT
+9 DO EN^DDIOL("Date/Time Read must be after the Administered Date/Time: "_$$FMTE^XLFDT(ADMDT))
End DoDot:1
+10 IF +READDT>0
Begin DoDot:1
+11 SET HOURS=$$FMDIFF^XLFDT(READDT,ADMDT,2)\3600
+12 DO EN^DDIOL("Hours Read Post-Inoculation: "_HOURS)
End DoDot:1
+13 QUIT
+14 ;
ELOT ;
+1 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))'=""
Begin DoDot:1
+2 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+3 SET PXCEINT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+4 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+5 SET DIR("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+6 SET DIR(0)="PAO^9999999.41:EM^K:$P(^(0),U,3)'=0!($P(^(0),U,4)'=$P(PXCEAFTR(0),U,1)) X"
+7 SET DIR("A")=$PIECE(PXCETEXT,"~",4)
+8 if $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+9 DO ^DIR
+10 KILL DIR,DA
+11 IF X="@"
SET Y="@"
+12 IF '$TEST
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXCEEND=1
QUIT
+13 if Y'<0
SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+14 QUIT
+15 ;
EPOV ;Edit the Associated DX
+1 ;Not used, adding/editing diagnosis removed in PX*1.0*211
+2 NEW PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
+3 SET PXDATE=$SELECT($DATA(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$DATA(PXCEAPDT)=1:PXCEAPDT,1:DT)
+4 SET PXACSREC=$$ACTDT^PXDXUTL(PXDATE)
SET PXACS=$PIECE(PXACSREC,"^",3)
+5 IF PXACS["-"
SET PXACS=$PIECE(PXACS,"-",1,2)
+6 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))'=""
Begin DoDot:1
+7 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+8 SET PXCEINT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+9 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+10 SET DIR("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+11 IF $PIECE(PXACSREC,U,1)'="ICD"
Begin DoDot:1
+12 SET PXDXASK=PXACS_" "_$PIECE(PXCETEXT,"~",4)
+13 SET PXDEF=$GET(DIR("B"))
SET PXAGAIN=0
DO ^PXDSLK
IF PXXX=-1
SET Y=-1
QUIT
+14 IF PXXX="@"
SET Y="@"
QUIT
+15 SET Y=$PIECE($$ICDDATA^ICDXCODE("DIAG",$PIECE($PIECE(PXXX,U,1),";",2),PXDATE,"E"),U,1)
End DoDot:1
+16 IF $PIECE(PXACSREC,U,1)="ICD"
Begin DoDot:1
+17 SET DIR(0)=PXCEFILE_","_$PIECE(PXCETEXT,"~",3)_"A"
+18 SET DIR("A")=PXACS_" "_$PIECE(PXCETEXT,"~",4)
+19 if $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+20 DO ^DIR
End DoDot:1
+21 KILL DIR,DA
+22 IF X="@"
SET Y="@"
SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
QUIT
+23 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXCEEND=1
SET PXCEQUIT=1
QUIT
+24 ;S:$P(PXCETEXT,"~",3)=".08" PXCEQUIT=1 Q
IF +Y'>0
SET PXCEEND=1
QUIT
+25 ;See if this diagnosis is in the PXCEAFTR(0)
+26 IF $PIECE(PXCETEXT,"~",2)'=1
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",1))
SET PXCEEND=1
+27 IF $PIECE(PXCETEXT,"~",2)'=2
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",2))
SET PXCEEND=1
+28 IF $PIECE(PXCETEXT,"~",2)'=3
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",3))
SET PXCEEND=1
+29 IF $PIECE(PXCETEXT,"~",2)'=4
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",4))
SET PXCEEND=1
+30 IF $PIECE(PXCETEXT,"~",2)'=5
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",5))
SET PXCEEND=1
+31 IF $PIECE(PXCETEXT,"~",2)'=6
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",6))
SET PXCEEND=1
+32 IF $PIECE(PXCETEXT,"~",2)'=7
IF (+Y=$PIECE($GET(PXCEAFTR(80)),"^",7))
SET PXCEEND=1
+33 IF $PIECE(PXCETEXT,"~",2)'=8
IF (+Y=$PIECE($GET(PXCEAFTR8(80)),"^",8))
SET PXCEEND=1
+34 ;
+35 ; check for duplicate diagnosis in OTHER DIAGNOSIS
+36 NEW DX
if +$GET(PXCEFIEN)
Begin DoDot:1
+37 NEW CNT
SET CNT=0
FOR
SET CNT=$ORDER(^AUPNVIMM(PXCEFIEN,3,CNT))
if '+CNT
QUIT
Begin DoDot:2
+38 SET DX(^AUPNVIMM(PXCEFIEN,3,CNT,0))=""
End DoDot:2
End DoDot:1
+39 IF +$DATA(DX(+Y))
SET PXCEEND=1
+40 ;
+41 IF $GET(PXCEEND)=1
WRITE !,$CHAR(7),"Duplicate Diagnosis is not allowed."
DO WAIT^PXCEHELP
QUIT
+42 SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+43 if +Y>0
DO DIAGNOS^PXCEVFI4(+Y)
+44 QUIT
+45 ;
EPOV2 ; edit OTHER DIAGNOSIS
+1 ;Not used, adding/editing diagnosis removed in PX*1.0*211
+2 if '+$GET(PXCEFIEN)
QUIT
+3 NEW PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
+4 SET PXDATE=$SELECT($DATA(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$DATA(PXCEAPDT)=1:PXCEAPDT,1:DT)
+5 SET PXACSREC=$$ACTDT^PXDXUTL(PXDATE)
SET PXACS=$PIECE(PXACSREC,"^",3)
+6 IF PXACS["-"
SET PXACS=$PIECE(PXACS,"-",1,2)
+7 ; get multiple diagnosis
+8 NEW CNT,DX,DXS
SET CNT=0
FOR
SET CNT=$ORDER(^AUPNVIMM(PXCEFIEN,3,CNT))
if '+CNT
QUIT
Begin DoDot:1
+9 SET DX(CNT)=^AUPNVIMM(PXCEFIEN,3,CNT,0)
+10 SET DXS(DX(CNT))=""
End DoDot:1
+11 ; if no entries, show empty entry to allow adding
IF '$DATA(DX)
SET DX(1)=""
+12 IF $PIECE(PXACSREC,U,1)="ICD"
Begin DoDot:1
+13 NEW DIR
SET DIR(0)=PXCEFILE_"3,"_$PIECE(PXCETEXT,"~",3)_"A"
+14 SET DIR("A")=PXACS_" "_$PIECE(PXCETEXT,"~",4)
+15 SET CNT=0
FOR
SET CNT=$ORDER(DX(CNT))
if '+CNT!($DATA(DTOUT)!($DATA(DUOUT)))
QUIT
Begin DoDot:2
+16 NEW DA,X,Y
+17 SET DIR("B")=$$EXTERNAL^DILFD(PXCEFILE_3,".01","",DX(CNT),"PXCEDILF")
+18 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if X=""
QUIT
+19 IF X="@"
WRITE !
IF +$$READ("YE","Are you sure you want to remove this entry","NO")
DO DELDX(CNT)
QUIT
+20 ; quit if entry already exists
IF +$DATA(DXS(+Y))
if Y(0)'=DIR("B")
WRITE !!,$CHAR(7),"Entry matches Other Diagnosis. Duplicate Diagnosis is not allowed."
if Y(0)'=DIR("B")
DO WAIT^PXCEHELP
QUIT
+21 ; quit if entry matches primary diagnosis
IF +Y=$PIECE($GET(^AUPNVIMM(PXCEFIEN,13)),U,4)
Begin DoDot:3
+22 WRITE !!,$CHAR(7),"Entry matches Primary Diagnosis. Duplicate Diagnosis is not allowed."
DO WAIT^PXCEHELP
End DoDot:3
QUIT
+23 ; ask to overwrite or add new entry
IF Y(0)'=DIR("B")
Begin DoDot:3
+24 IF DIR("B")'=""
NEW ANS
WRITE !
SET ANS=$$READ("SA^A:ADD;R:REPLACE","Do you want to ADD a new entry or REPLACE the current entry? ","ADD")
WRITE !
+25 ; if no current entry, always add
IF DIR("B")=""
SET ANS="A"
+26 IF $PIECE(ANS,U)="A"!($PIECE(ANS,U)="R")
Begin DoDot:4
+27 NEW FDA,FDAIEN,ERRMSG,IEN
+28 SET IEN=$SELECT($PIECE(ANS,U)="A":"+1,"_PXCEFIEN_",",1:CNT_","_PXCEFIEN_",")
+29 SET FDA(PXCEFILE_3,IEN,.01)=+Y
+30 DO DIAGNOS^PXCEVFI4(+Y,1)
+31 IF '+$GET(PXCEQUIT)
DO UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
+34 ;********************************
EVENTDT(PXCEAFTR) ;Edit the Event Date and Time.
+1 NEW DEFAULT,EVENTDT,HELP,IEN,PROMPT
+2 SET DEFAULT=$PIECE(^TMP("PXK",$JOB,"IMM",1,12,"BEFORE"),U,1)
+3 SET HELP="D EVDTHELP^PXCEVIMM"
+4 SET PROMPT="Administered Date and Time"
+5 SET EVENTDT=$$GETDT^PXDATE(-1,-1,-1,DEFAULT,PROMPT,HELP)
+6 SET $PIECE(PXCEAFTR(12),U,1)=EVENTDT
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
SET PXCEEND=1
QUIT
+8 QUIT
+9 ;
+10 ;********************************
EVDTHELP ;Event Date and Time help.
+1 NEW ERR,RESULT,TEXT
+2 SET RESULT=$$GET1^DID(9000010.11,1201,"","DESCRIPTION","TEXT","ERR")
+3 DO BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V Immunization Administered Date and Time Help")
+4 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+5 QUIT
+6 ;
+7 ;********************************
DELDX(DA) ; delete OTHER DIAGNOSIS
+1 KILL DXS(DX(DA)),DX(DA)
+2 SET DA(1)=PXCEFIEN
SET DIK="^AUPNVIMM("_DA(1)_",3,"
DO ^DIK
WRITE !!,"Entry successfully removed."
DO WAIT^PXCEHELP
+3 QUIT
+4 ;
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
+1 NEW DIR,X,Y,DUOUT,DTOUT,DIRUT
SET DIR(0)=TYPE
+2 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+3 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+4 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+5 IF $DATA(HELP)
SET DIR("?")=HELP
+6 DO ^DIR
+7 IF $GET(X)="@"
SET Y="@"
GOTO READX
+8 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
READX QUIT Y
+1 ;
SKIP ;Used to by-pass roll and scroll editing of a field.
+1 SET (X,Y)=""
+2 QUIT
+3 ;
+4 ;********************************
+5 ;Display text for the .01 field which is a pointer to Immunization.
+6 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEIMM,PXCEDT) ;
+1 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+2 SET PXCEINT=$PIECE(PXCEIMM,"^",1)
+3 SET PXCEEXT=$$EXTERNAL^DILFD(9000010.11,.01,"",PXCEINT,"PXCEDILF")
+4 QUIT $SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
+5 ;
DISPLN(PXCEINT,PCEDT) ; display lot number with manufacturer
+1 NEW PXCEDILF,PXCEEXT,PXV2,PXVMAN
+2 SET PXCEEXT=$$EXTERNAL^DILFD(9000010.11,1207,"",PXCEINT,"PXCEDILF")
+3 SET PXV2=$PIECE(^AUTTIML(PXCEINT,0),"^",2)
SET PXVMAN=$$EXTERNAL^DILFD(9999999.41,.02,"",PXV2,"PXCEDILF")
+4 QUIT $SELECT('$DATA(DIERR):PXCEEXT_" "_PXVMAN,1:PXCEINT)
