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 Apr 09, 2024@21:28:34 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 ;
