Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCEVIMM

PXCEVIMM.m

Go to the documentation of this file.
  1. 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
  1. ;;
  1. Q
  1. ;
  1. ;Line with the line label "FORMAT"
  1. ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
  1. ; 1 2 3 4 5
  1. ;
  1. ;Following lines:
  1. ;;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. ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
  1. ;The Display & Edit routines are for special cases.
  1. ; (The .01 field cannot have a special edit.)
  1. ;
  1. FORMAT ;;Immunization~9000010.11~0,2,3,11,12,13,14,15,16,811,812~0~^AUPNVIMM
  1. ;;0~1~.01~Immunization: ~Immunization: ~~~~~B
  1. ;;13~1~1301~Information Source: ~Information Source: ~~~~~D
  1. ;;12~7~1207~Lot Number: ~Lot Number: ~$$DISPLN^PXCEVIMM~~~~D
  1. ;;12~22~1222~Ordered By Policy: ~Ordered By Policy: ~~~~~D
  1. ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
  1. ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
  1. ;;0~4~.04~Series: ~Series: ~~~~~D
  1. ;;0~6~.06~Reaction: ~Reaction: ~~~~~D
  1. ;;0~7~.07~Repeat Contraindicated: ~Repeat Contraindicated: ~~ECONTRAI^PXCEVIMM~~~D
  1. ;;12~1~1201~Administered Date and Time: ~Administered Date and Time: ~~EVENTDT^PXCEVIMM(.PXCEAFTR)~~~D
  1. ;;12~20~1220~Warning Acknowledged: ~Warning Acknowledged: ~~~~~D
  1. ;;16~1~1601~Warning Override Reason: ~Warning Override Reason: ~~~~~D
  1. ;;13~12~1312~Dose: ~Dose: ~~~~~D
  1. ;;13~13~1313~Dose Units: ~Dose Units: ~~~~~D
  1. ;;13~2~1302~Route of Administration: ~Route of Administration: ~~~~~D
  1. ;;13~3~1303~Site of Administration (Body): ~Site of Administration (Body): ~~~~~D
  1. ;;2~0~2~VIS Offered/Given: ~VIS: ~$$DISPVIS^PXCEVIS~EVIS^PXCEVIS~~~D
  1. ;;811~1~81101~Comments: ~Comments: ~~~~~D
  1. ;;812~2~81202~Package: ~Package: ~~SKIP^PXCEVIMM~~~D
  1. ;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCEVIMM~~~D
  1. ;;13~4~1304~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
  1. ;;3~2~.01~Other Diagnosis: ~Other Diagnosis: ~$$DISPLY01^PXCEPOV~SKIP^PXCEVIMM~~S~
  1. ;;14~3~1403~Date and Time Read: ~Date/Time Read: ~~EREADDT^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
  1. ;;14~2~1402~Reading in Millimeters (mm): ~Reading in Millimeters (mm): ~~EREAD^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
  1. ;;14~1~1401~Results: ~Results: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
  1. ;;14~4~1404~Reader: ~Reader: ~~EPROV12^PXCEPRV~~~D
  1. ;;14~5~1405~Date and Time Reading Recorded: ~Reading Recorded: ~~SKIP^PXCEVIMM~~~D
  1. ;;14~6~1406~Hours Read Post-Inoculation: ~Hours Read Post-Inoculation: ~~SKIP^PXCEVIMM~~~D
  1. ;;15~1~1501~Reading Comments: ~Reading Comments: ~~EREADDATA^PXCEVIMM(PXCEFIEN,.PXCEAFTR,PXCETEXT)~~~D
  1. ;;
  1. ;
  1. ;Cannot ask word processing
  1. ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
  1. ;
  1. ;The interface for AICS to get list on form for help.
  1. INTRFACE ;;PX SELECT IMMUNIZATIONS
  1. ;
  1. ;********************************
  1. ;Special cases for display.
  1. ;
  1. ;********************************
  1. ;Special cases for edit.
  1. ;
  1. ECONTRAI ;
  1. I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
  1. . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
  1. . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
  1. . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
  1. . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1. E S DIR("B")="NO"
  1. S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
  1. S DIR("A")=$P(PXCETEXT,"~",4)
  1. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
  1. D ^DIR
  1. K DIR,DA
  1. I X="@" S Y="@"
  1. E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
  1. S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
  1. Q
  1. ;
  1. EREAD(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading.
  1. N DONE,READING
  1. ;If there is no reading date/time quit.
  1. I $P(PXCEAFTR(14),U,3)="" Q
  1. S DONE=0
  1. F Q:DONE D
  1. . D EREADDATA(DA,.PXCEAFTR,PXCETEXT)
  1. . I PXCEEND=1 S DONE=1 Q
  1. . S READING=$P(PXCEAFTR(14),U,2)
  1. . I READING'="" S DONE=1 Q
  1. Q
  1. ;
  1. EREADDATA(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading data.
  1. N DIR,FLDNUM,MSG,NODE,PIECE,PROMPT,X,Y
  1. S NODE=$P(PXCETEXT,"~",1)
  1. S PIECE=$P(PXCETEXT,"~",2)
  1. S FLDNUM=$P(PXCETEXT,"~",3)
  1. S PROMPT=$P(PXCETEXT,"~",4)
  1. S DIR(0)=9000010.11_","_FLDNUM_"A"
  1. S DIR("A")=PROMPT
  1. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
  1. D ^DIR
  1. ;If any of the reading data is deleted, delete all of it.
  1. I X="@" D Q
  1. . S PXCEEND=1
  1. . S PXCEAFTR(14)="",^AUPNVIMM(DA,14)=""
  1. . S PXCEAFTR(15)="",^AUPNVIMM(DA,15)=""
  1. I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
  1. S $P(PXCEAFTR(NODE),U,PIECE)=$P(Y,U,1)
  1. Q
  1. ;
  1. EREADDT(DA,PXCEAFTR,PXCETEXT) ;Enter/edit reading date and time.
  1. N ADMDT,DONE,HOURS,READDT
  1. S ADMDT=$P(PXCEAFTR(12),U,1)
  1. S DONE=0
  1. F Q:DONE D
  1. . D EREADDATA(DA,.PXCEAFTR,PXCETEXT)
  1. . S READDT=$P(PXCEAFTR(14),U,3)
  1. . I READDT="" S DONE=1 Q
  1. . I READDT>ADMDT S DONE=1 Q
  1. . D EN^DDIOL("Date/Time Read must be after the Administered Date/Time: "_$$FMTE^XLFDT(ADMDT))
  1. I +READDT>0 D
  1. . S HOURS=$$FMDIFF^XLFDT(READDT,ADMDT,2)\3600
  1. . D EN^DDIOL("Hours Read Post-Inoculation: "_HOURS)
  1. Q
  1. ;
  1. ELOT ;
  1. I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
  1. . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
  1. . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
  1. . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
  1. . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1. S DIR(0)="PAO^9999999.41:EM^K:$P(^(0),U,3)'=0!($P(^(0),U,4)'=$P(PXCEAFTR(0),U,1)) X"
  1. S DIR("A")=$P(PXCETEXT,"~",4)
  1. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
  1. D ^DIR
  1. K DIR,DA
  1. I X="@" S Y="@"
  1. E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
  1. S:Y'<0 $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
  1. Q
  1. ;
  1. EPOV ;Edit the Associated DX
  1. ;Not used, adding/editing diagnosis removed in PX*1.0*211
  1. N PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
  1. S PXDATE=$S($D(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$D(PXCEAPDT)=1:PXCEAPDT,1:DT)
  1. S PXACSREC=$$ACTDT^PXDXUTL(PXDATE),PXACS=$P(PXACSREC,"^",3)
  1. I PXACS["-" S PXACS=$P(PXACS,"-",1,2)
  1. I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
  1. .N DIERR,PXCEDILF,PXCEINT,PXCEEXT
  1. .S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
  1. .S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
  1. .S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1. I $P(PXACSREC,U,1)'="ICD" D
  1. . S PXDXASK=PXACS_" "_$P(PXCETEXT,"~",4)
  1. . S PXDEF=$G(DIR("B")),PXAGAIN=0 D ^PXDSLK I PXXX=-1 S Y=-1 Q
  1. . I PXXX="@" S Y="@" Q
  1. . S Y=$P($$ICDDATA^ICDXCODE("DIAG",$P($P(PXXX,U,1),";",2),PXDATE,"E"),U,1)
  1. I $P(PXACSREC,U,1)="ICD" D
  1. . S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
  1. . S DIR("A")=PXACS_" "_$P(PXCETEXT,"~",4)
  1. . S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
  1. . D ^DIR
  1. K DIR,DA
  1. I X="@" S Y="@" S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^") Q
  1. I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
  1. I +Y'>0 S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".08" PXCEQUIT=1 Q
  1. ;See if this diagnosis is in the PXCEAFTR(0)
  1. I $P(PXCETEXT,"~",2)'=1,(+Y=$P($G(PXCEAFTR(80)),"^",1)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=2,(+Y=$P($G(PXCEAFTR(80)),"^",2)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=3,(+Y=$P($G(PXCEAFTR(80)),"^",3)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=4,(+Y=$P($G(PXCEAFTR(80)),"^",4)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=5,(+Y=$P($G(PXCEAFTR(80)),"^",5)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=6,(+Y=$P($G(PXCEAFTR(80)),"^",6)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=7,(+Y=$P($G(PXCEAFTR(80)),"^",7)) S PXCEEND=1
  1. I $P(PXCETEXT,"~",2)'=8,(+Y=$P($G(PXCEAFTR8(80)),"^",8)) S PXCEEND=1
  1. ;
  1. ; check for duplicate diagnosis in OTHER DIAGNOSIS
  1. N DX D:+$G(PXCEFIEN)
  1. . N CNT S CNT=0 F S CNT=$O(^AUPNVIMM(PXCEFIEN,3,CNT)) Q:'+CNT D
  1. . . S DX(^AUPNVIMM(PXCEFIEN,3,CNT,0))=""
  1. I +$D(DX(+Y)) S PXCEEND=1
  1. ;
  1. I $G(PXCEEND)=1 W !,$C(7),"Duplicate Diagnosis is not allowed." D WAIT^PXCEHELP Q
  1. S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
  1. D:+Y>0 DIAGNOS^PXCEVFI4(+Y)
  1. Q
  1. ;
  1. EPOV2 ; edit OTHER DIAGNOSIS
  1. ;Not used, adding/editing diagnosis removed in PX*1.0*211
  1. Q:'+$G(PXCEFIEN)
  1. N PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
  1. S PXDATE=$S($D(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$D(PXCEAPDT)=1:PXCEAPDT,1:DT)
  1. S PXACSREC=$$ACTDT^PXDXUTL(PXDATE),PXACS=$P(PXACSREC,"^",3)
  1. I PXACS["-" S PXACS=$P(PXACS,"-",1,2)
  1. ; get multiple diagnosis
  1. N CNT,DX,DXS S CNT=0 F S CNT=$O(^AUPNVIMM(PXCEFIEN,3,CNT)) Q:'+CNT D
  1. . S DX(CNT)=^AUPNVIMM(PXCEFIEN,3,CNT,0)
  1. . S DXS(DX(CNT))=""
  1. I '$D(DX) S DX(1)="" ; if no entries, show empty entry to allow adding
  1. I $P(PXACSREC,U,1)="ICD" D
  1. . N DIR S DIR(0)=PXCEFILE_"3,"_$P(PXCETEXT,"~",3)_"A"
  1. . S DIR("A")=PXACS_" "_$P(PXCETEXT,"~",4)
  1. . S CNT=0 F S CNT=$O(DX(CNT)) Q:'+CNT!($D(DTOUT)!($D(DUOUT))) D
  1. . . N DA,X,Y
  1. . . S DIR("B")=$$EXTERNAL^DILFD(PXCEFILE_3,".01","",DX(CNT),"PXCEDILF")
  1. . . D ^DIR Q:$D(DTOUT)!$D(DUOUT) Q:X=""
  1. . . I X="@" W ! I +$$READ("YE","Are you sure you want to remove this entry","NO") D DELDX(CNT) Q
  1. . . 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
  1. . . I +Y=$P($G(^AUPNVIMM(PXCEFIEN,13)),U,4) D Q ; quit if entry matches primary diagnosis
  1. . . . W !!,$C(7),"Entry matches Primary Diagnosis. Duplicate Diagnosis is not allowed." D WAIT^PXCEHELP
  1. . . I Y(0)'=DIR("B") D ; ask to overwrite or add new entry
  1. . . . 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 !
  1. . . . I DIR("B")="" S ANS="A" ; if no current entry, always add
  1. . . . I $P(ANS,U)="A"!($P(ANS,U)="R") D Q
  1. . . . . N FDA,FDAIEN,ERRMSG,IEN
  1. . . . . S IEN=$S($P(ANS,U)="A":"+1,"_PXCEFIEN_",",1:CNT_","_PXCEFIEN_",")
  1. . . . . S FDA(PXCEFILE_3,IEN,.01)=+Y
  1. . . . . D DIAGNOS^PXCEVFI4(+Y,1)
  1. . . . . I '+$G(PXCEQUIT) D UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
  1. Q
  1. ;
  1. ;********************************
  1. EVENTDT(PXCEAFTR) ;Edit the Event Date and Time.
  1. N DEFAULT,EVENTDT,HELP,IEN,PROMPT
  1. S DEFAULT=$P(^TMP("PXK",$J,"IMM",1,12,"BEFORE"),U,1)
  1. S HELP="D EVDTHELP^PXCEVIMM"
  1. S PROMPT="Administered Date and Time"
  1. S EVENTDT=$$GETDT^PXDATE(-1,-1,-1,DEFAULT,PROMPT,HELP)
  1. S $P(PXCEAFTR(12),U,1)=EVENTDT
  1. I $D(DUOUT)!$D(DTOUT) S PXCEEND=1 Q
  1. Q
  1. ;
  1. ;********************************
  1. EVDTHELP ;Event Date and Time help.
  1. N ERR,RESULT,TEXT
  1. S RESULT=$$GET1^DID(9000010.11,1201,"","DESCRIPTION","TEXT","ERR")
  1. D BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V Immunization Administered Date and Time Help")
  1. I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
  1. Q
  1. ;
  1. ;********************************
  1. DELDX(DA) ; delete OTHER DIAGNOSIS
  1. K DXS(DX(DA)),DX(DA)
  1. S DA(1)=PXCEFIEN,DIK="^AUPNVIMM("_DA(1)_",3," D ^DIK W !!,"Entry successfully removed." D WAIT^PXCEHELP
  1. Q
  1. ;
  1. READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
  1. N DIR,X,Y,DUOUT,DTOUT,DIRUT S DIR(0)=TYPE
  1. I $D(SCREEN) S DIR("S")=SCREEN
  1. I $G(PROMPT)]"" S DIR("A")=PROMPT
  1. I $G(DEFAULT)]"" S DIR("B")=DEFAULT
  1. I $D(HELP) S DIR("?")=HELP
  1. D ^DIR
  1. I $G(X)="@" S Y="@" G READX
  1. I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
  1. READX Q Y
  1. ;
  1. SKIP ;Used to by-pass roll and scroll editing of a field.
  1. S (X,Y)=""
  1. Q
  1. ;
  1. ;********************************
  1. ;Display text for the .01 field which is a pointer to Immunization.
  1. ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
  1. DISPLY01(PXCEIMM,PXCEDT) ;
  1. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
  1. S PXCEINT=$P(PXCEIMM,"^",1)
  1. S PXCEEXT=$$EXTERNAL^DILFD(9000010.11,.01,"",PXCEINT,"PXCEDILF")
  1. Q $S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1. ;
  1. DISPLN(PXCEINT,PCEDT) ; display lot number with manufacturer
  1. N PXCEDILF,PXCEEXT,PXV2,PXVMAN
  1. S PXCEEXT=$$EXTERNAL^DILFD(9000010.11,1207,"",PXCEINT,"PXCEDILF")
  1. S PXV2=$P(^AUTTIML(PXCEINT,0),"^",2),PXVMAN=$$EXTERNAL^DILFD(9999999.41,.02,"",PXV2,"PXCEDILF")
  1. Q $S('$D(DIERR):PXCEEXT_" "_PXVMAN,1:PXCEINT)