- 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 Feb 18, 2025@23:54:41 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)