- PXUTL1 ;ISL/dee - Utility routines used by PCE ;06/14/2018
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**25,134,149,199,211**;Aug 12, 1996;Build 454
- ;
- ;Reference to ICDEX supported by ICR #5747.
- ;
- Q
- ;
- EXTTEXT(IEN,REQUIRED,FILE,FIELD1,FIELD2) ;Returns the external form.
- ;* 1/24/2012 - ICD-10 REMEDIATION note
- ;* This function was being used mostly to retrieve the diagnosis description.
- ;* The DESCRIPTION field in file #80 is now a multiple and does not work
- ;* with this function so most of the routines that were using this have been
- ;* recoded. This function is still viable as a DIC wrapper but must be used
- ;* for 'flat' fields and not multiples.
- ;
- ;Parameters:
- ; IEN the IEN in the file that the text is wanted for.
- ; REQUIRED if this is not zero and no text is found
- ; then "UNKNOWN" is returned.
- ; FILE the file number
- ; FIELD1 the field number that the text is in
- ; FIELD2 if the parameter is passed and there is no text
- ; in field1 then the text in this field will be
- ; returned if there is some.
- ;
- N DIC,DR,DA,DIQ,PXUTDIQ1,PXTEXT,Y,X
- I $G(FILE)>0,$G(FIELD1)>0 D
- . S DIC=FILE
- . S DR=FIELD1
- . S:$G(FIELD2)>0 DR=DR_";"_FIELD2
- . S DA=IEN
- . S DIQ="PXUTDIQ1("
- . S DIQ(0)="E"
- . D EN^DIQ1
- . I $G(PXUTDIQ1(FILE,DA,FIELD1,"E"))]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD1,"E")
- . E I $G(FIELD2)>0,$G(PXUTDIQ1(FILE,DA,FIELD2,"E"))]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD2,"E")
- . E I REQUIRED S PXTEXT="UNKNOWN"
- E I REQUIRED S PXTEXT="UNKNOWN"
- Q PXTEXT
- ;
- PRIMVPRV(PXUTVST) ;Returns the primary provider if there is one
- ; for the passed visit otherwise returns 0.
- N PXCATEMP
- S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPRV",0,4)
- Q $S(PXCATEMP>0:$P(^AUPNVPRV(PXCATEMP,0),"^"),1:0)
- ;
- PRIMVPOV(PXUTVST) ;Returns the primary diagnosis if there is one
- ; for the passed visit otherwise returns 0.
- N PXCATEMP
- S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPOV",0,12)
- Q $S(PXCATEMP>0:$P(^AUPNVPOV(PXCATEMP,0),"^"),1:0)
- ;
- PRIMSEC(PXUTVST,PXUTAUPN,PXUTNODE,PXUPIECE) ;Returns IEN of the primary one
- ; if there is one for the passed visit otherwise returns 0.
- ; Parameters:
- ; PXUTVST Pointer to the visit
- ; PXUTAUPN V-File global e.g. "^AUPNVPRV"
- ; PXUTNODE The node that the Primary/Secondary field is on
- ; PXUPIECE The piece of the Primary/Secondary field
- ;
- N PXUTPRIM
- S PXUTPRIM=0
- F S PXUTPRIM=$O(@(PXUTAUPN_"(""AD"",PXUTVST,PXUTPRIM)")) Q:PXUTPRIM'>0 I "P"=$P(@(PXUTAUPN_"(PXUTPRIM,PXUTNODE)"),"^",PXUPIECE) Q
- Q +PXUTPRIM
- ;
- DISPOSIT(PXUTLDFN,PXUTLDT,PXUTVIEN) ;Checks to see if a visit is a disposition
- I PXUTVIEN=+$P($G(^SCE(+$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18),0)),"^",5) Q +$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18)
- Q 0
- ;
- APPOINT(PXUTLDFN,PXUTLDT,HLOC) ;Returns 1 if the patient has an appointment
- ;at PXUTLDT for clinic HLOC.
- Q HLOC=+$G(^DPT(+PXUTLDFN,"S",+PXUTLDT,0))
- ;
- VST2APPT(VISIT) ;Is this visit related to an appointment
- ;Returns
- ; 1 if the visit is being pointed to by an appointment
- ; 0 if the visit is NOT being pointed to by an appointment
- ;-1 if the visit is invalid
- ;
- N VISIT0
- S VISIT0=$G(^AUPNVSIT($G(VISIT),0))
- Q:VISIT0="" -1
- Q $$VSTAPPT($P(VISIT0,"^",5),$P(VISIT0,"^",1),$P(VISIT0,"^",22),VISIT)
- ;
- VSTAPPT(PXUTLPAT,PXUTLDT,PXUTLLOC,PXUTLVST) ;Returns 1 if the visit is being pointed to by an
- ; appointment otherwise 0.
- I PXUTLLOC]"",PXUTLLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)),PXUTLVST=+$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5) Q 1
- Q 0
- ;
- APPT2VST(PXUTLPAT,PXUTLDT,HLOC) ;Returns IEN of visit that the related
- ;appointment points to at PXUTLDT for clinic HLOC otherwise 0.
- I HLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)) Q +$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5)
- Q 0
- ;
- DXNARR(CODEIEN,PXUTLDT) ;Returns the versioned full text from file #80,
- ;field #68
- N NARR,PXLDX,PXNO,PXCOD
- I $G(CODEIEN)="" Q ""
- S:$G(PXUTLDT)="" PXUTLDT=DT
- S NARR=$$LD^ICDEX(80,CODEIEN,PXUTLDT,.NARR)
- Q $S($P(NARR,U,1)=-1:"",1:NARR)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXUTL1 4174 printed Jan 18, 2025@03:32:39 Page 2
- PXUTL1 ;ISL/dee - Utility routines used by PCE ;06/14/2018
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**25,134,149,199,211**;Aug 12, 1996;Build 454
- +2 ;
- +3 ;Reference to ICDEX supported by ICR #5747.
- +4 ;
- +5 QUIT
- +6 ;
- EXTTEXT(IEN,REQUIRED,FILE,FIELD1,FIELD2) ;Returns the external form.
- +1 ;* 1/24/2012 - ICD-10 REMEDIATION note
- +2 ;* This function was being used mostly to retrieve the diagnosis description.
- +3 ;* The DESCRIPTION field in file #80 is now a multiple and does not work
- +4 ;* with this function so most of the routines that were using this have been
- +5 ;* recoded. This function is still viable as a DIC wrapper but must be used
- +6 ;* for 'flat' fields and not multiples.
- +7 ;
- +8 ;Parameters:
- +9 ; IEN the IEN in the file that the text is wanted for.
- +10 ; REQUIRED if this is not zero and no text is found
- +11 ; then "UNKNOWN" is returned.
- +12 ; FILE the file number
- +13 ; FIELD1 the field number that the text is in
- +14 ; FIELD2 if the parameter is passed and there is no text
- +15 ; in field1 then the text in this field will be
- +16 ; returned if there is some.
- +17 ;
- +18 NEW DIC,DR,DA,DIQ,PXUTDIQ1,PXTEXT,Y,X
- +19 IF $GET(FILE)>0
- IF $GET(FIELD1)>0
- Begin DoDot:1
- +20 SET DIC=FILE
- +21 SET DR=FIELD1
- +22 if $GET(FIELD2)>0
- SET DR=DR_";"_FIELD2
- +23 SET DA=IEN
- +24 SET DIQ="PXUTDIQ1("
- +25 SET DIQ(0)="E"
- +26 DO EN^DIQ1
- +27 IF $GET(PXUTDIQ1(FILE,DA,FIELD1,"E"))]""
- SET PXTEXT=PXUTDIQ1(FILE,DA,FIELD1,"E")
- +28 IF '$TEST
- IF $GET(FIELD2)>0
- IF $GET(PXUTDIQ1(FILE,DA,FIELD2,"E"))]""
- SET PXTEXT=PXUTDIQ1(FILE,DA,FIELD2,"E")
- +29 IF '$TEST
- IF REQUIRED
- SET PXTEXT="UNKNOWN"
- End DoDot:1
- +30 IF '$TEST
- IF REQUIRED
- SET PXTEXT="UNKNOWN"
- +31 QUIT PXTEXT
- +32 ;
- PRIMVPRV(PXUTVST) ;Returns the primary provider if there is one
- +1 ; for the passed visit otherwise returns 0.
- +2 NEW PXCATEMP
- +3 SET PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPRV",0,4)
- +4 QUIT $SELECT(PXCATEMP>0:$PIECE(^AUPNVPRV(PXCATEMP,0),"^"),1:0)
- +5 ;
- PRIMVPOV(PXUTVST) ;Returns the primary diagnosis if there is one
- +1 ; for the passed visit otherwise returns 0.
- +2 NEW PXCATEMP
- +3 SET PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPOV",0,12)
- +4 QUIT $SELECT(PXCATEMP>0:$PIECE(^AUPNVPOV(PXCATEMP,0),"^"),1:0)
- +5 ;
- PRIMSEC(PXUTVST,PXUTAUPN,PXUTNODE,PXUPIECE) ;Returns IEN of the primary one
- +1 ; if there is one for the passed visit otherwise returns 0.
- +2 ; Parameters:
- +3 ; PXUTVST Pointer to the visit
- +4 ; PXUTAUPN V-File global e.g. "^AUPNVPRV"
- +5 ; PXUTNODE The node that the Primary/Secondary field is on
- +6 ; PXUPIECE The piece of the Primary/Secondary field
- +7 ;
- +8 NEW PXUTPRIM
- +9 SET PXUTPRIM=0
- +10 FOR
- SET PXUTPRIM=$ORDER(@(PXUTAUPN_"(""AD"",PXUTVST,PXUTPRIM)"))
- if PXUTPRIM'>0
- QUIT
- IF "P"=$PIECE(@(PXUTAUPN_"(PXUTPRIM,PXUTNODE)"),"^",PXUPIECE)
- QUIT
- +11 QUIT +PXUTPRIM
- +12 ;
- DISPOSIT(PXUTLDFN,PXUTLDT,PXUTVIEN) ;Checks to see if a visit is a disposition
- +1 IF PXUTVIEN=+$PIECE($GET(^SCE(+$PIECE($GET(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18),0)),"^",5)
- QUIT +$PIECE($GET(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18)
- +2 QUIT 0
- +3 ;
- APPOINT(PXUTLDFN,PXUTLDT,HLOC) ;Returns 1 if the patient has an appointment
- +1 ;at PXUTLDT for clinic HLOC.
- +2 QUIT HLOC=+$GET(^DPT(+PXUTLDFN,"S",+PXUTLDT,0))
- +3 ;
- VST2APPT(VISIT) ;Is this visit related to an appointment
- +1 ;Returns
- +2 ; 1 if the visit is being pointed to by an appointment
- +3 ; 0 if the visit is NOT being pointed to by an appointment
- +4 ;-1 if the visit is invalid
- +5 ;
- +6 NEW VISIT0
- +7 SET VISIT0=$GET(^AUPNVSIT($GET(VISIT),0))
- +8 if VISIT0=""
- QUIT -1
- +9 QUIT $$VSTAPPT($PIECE(VISIT0,"^",5),$PIECE(VISIT0,"^",1),$PIECE(VISIT0,"^",22),VISIT)
- +10 ;
- VSTAPPT(PXUTLPAT,PXUTLDT,PXUTLLOC,PXUTLVST) ;Returns 1 if the visit is being pointed to by an
- +1 ; appointment otherwise 0.
- +2 IF PXUTLLOC]""
- IF PXUTLLOC=+$GET(^DPT(+PXUTLPAT,"S",+PXUTLDT,0))
- IF PXUTLVST=+$PIECE($GET(^SCE(+$PIECE($GET(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5)
- QUIT 1
- +3 QUIT 0
- +4 ;
- APPT2VST(PXUTLPAT,PXUTLDT,HLOC) ;Returns IEN of visit that the related
- +1 ;appointment points to at PXUTLDT for clinic HLOC otherwise 0.
- +2 IF HLOC=+$GET(^DPT(+PXUTLPAT,"S",+PXUTLDT,0))
- QUIT +$PIECE($GET(^SCE(+$PIECE($GET(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5)
- +3 QUIT 0
- +4 ;
- DXNARR(CODEIEN,PXUTLDT) ;Returns the versioned full text from file #80,
- +1 ;field #68
- +2 NEW NARR,PXLDX,PXNO,PXCOD
- +3 IF $GET(CODEIEN)=""
- QUIT ""
- +4 if $GET(PXUTLDT)=""
- SET PXUTLDT=DT
- +5 SET NARR=$$LD^ICDEX(80,CODEIEN,PXUTLDT,.NARR)
- +6 QUIT $SELECT($PIECE(NARR,U,1)=-1:"",1:NARR)
- +7 ;