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

PXVRPC8.m

Go to the documentation of this file. 
  1. PXVRPC8 ;ISP/LMT - PCE RPCs for Skin Tests ;Jan 18, 2023@14:49:16
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**216,217,233**;Aug 12, 1996;Build 3
  1.  ;
  1.  ;
  1.  ; Reference to ^DIA(9999999.28,"C") in ICR #2602
  1.  ;
  1.  ;
  1. SKSHORT(PXRSLT,PXDATE,PXFLTR,PXOREXC,PXLOC) ;
  1.  ;
  1.  ; Returns list of skin tests
  1.  ;
  1.  ;Input:
  1.  ;    PXRSLT - Return value passed by reference (Required)
  1.  ;    PXDATE - Date (optional; defaults to TODAY)
  1.  ;             Used for determining skin test status
  1.  ;    PXFLTR - Filter (Optional; Defaults to "S:A")
  1.  ;             Possible values are:
  1.  ;               R:X   - Return entry with IEN X.
  1.  ;               N:X   - Return entry with #.01 field equal to X
  1.  ;               S:A   - Return all active entries.
  1.  ;               S:I   - Return all inactive entries.
  1.  ;               S:B   - Return all entries (both active and inactive).
  1.  ;   PXOREXC - Should entries defined in ORWPCE EXCLUDE SKIN TESTS be excluded? (optional)
  1.  ;             Used when PXFLTR is set to S:x.
  1.  ;     PXLOC - Used when excluding entries listed in ORWPCE EXCLUDE SKIN TESTS. (Optional)
  1.  ;             This is the location used when getting the parameter value at the Location level.
  1.  ;
  1.  ;Returns:
  1.  ;   (0)=Count of elements returned (0 if nothing found)
  1.  ;   (n)=SK^IEN^NAME^PRINT NAME
  1.  ;   (n)=CS^Coding System^Code^Variable pointer^Short Description
  1.  ;
  1.  N PXAUDIT,PXCNT,PXFLTRTYP,PXFLTRVAL,PXGETCSTAT,PXIEN,PXLST,PXNODE,PXSTAT
  1.  ;
  1.  I '$G(PXDATE) S PXDATE=DT
  1.  I $P($G(PXFLTR),":",1)'?1(1"R",1"N",1"S") S PXFLTR="S:A"
  1.  S PXFLTRTYP=$P(PXFLTR,":",1)
  1.  S PXFLTRVAL=$P(PXFLTR,":",2)
  1.  S PXCNT=0
  1.  ;
  1.  S PXAUDIT=0
  1.  I $$GET1^DID(9999999.28,.03,"","AUDIT")="YES, ALWAYS" S PXAUDIT=1
  1.  S PXGETCSTAT=$$GETCSTAT(PXDATE,PXAUDIT)
  1.  ;
  1.  I PXFLTRTYP="R" D
  1.  . S PXIEN=PXFLTRVAL
  1.  . I 'PXIEN Q
  1.  . I '$D(^AUTTSK(PXIEN,0)) Q
  1.  . D ADDENTRY(.PXRSLT,.PXCNT,.PXIEN,.PXDATE)
  1.  ;
  1.  I PXFLTRTYP="N" D
  1.  . I PXFLTRVAL="" Q
  1.  . S PXIEN=$O(^AUTTSK("B",PXFLTRVAL,0))
  1.  . I 'PXIEN Q
  1.  . D ADDENTRY(.PXRSLT,.PXCNT,.PXIEN,.PXDATE)
  1.  ;
  1.  I PXFLTRTYP="S" D
  1.  . I PXFLTRVAL'?1(1"A",1"I",1"B") S PXFLTRVAL="A"
  1.  . S PXIEN=0
  1.  . F  S PXIEN=$O(^AUTTSK(PXIEN)) Q:'PXIEN  D
  1.  . . I $G(PXOREXC),$$EXCLUDED^PXVRPC4(.PXLST,PXIEN,2,$G(PXLOC)) Q
  1.  . . S PXSTAT=$$GETSTAT(PXIEN,PXDATE,PXGETCSTAT,PXAUDIT)
  1.  . . I PXFLTRVAL="A",'PXSTAT Q
  1.  . . I PXFLTRVAL="I",PXSTAT Q
  1.  . . D ADDENTRY(.PXRSLT,.PXCNT,.PXIEN,.PXDATE)
  1.  ;
  1.  S PXRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. ADDENTRY(PXRSLT,PXCNT,PXIEN,PXDATE) ;
  1.  ;
  1.  N PXNODE
  1.  ;
  1.  S PXCNT=$G(PXCNT)+1
  1.  S PXNODE=$G(^AUTTSK(PXIEN,0))
  1.  S PXRSLT(PXCNT)="SK^"_PXIEN_U_$P(PXNODE,U,1)_U_$P($G(^AUTTSK(PXIEN,12)),U,1)
  1.  D GETCS(.PXRSLT,.PXCNT,.PXIEN,.PXDATE)
  1.  ;
  1.  Q
  1.  ;
  1. GETSTAT(PXSK,PXDATE,PXCURR,PXAUDIT) ;
  1.  ;
  1.  N PXLASTEDIT,PXSTAT
  1.  ;
  1.  I PXCURR Q '$P($G(^AUTTSK(PXSK,0)),U,3)
  1.  ;
  1.  I PXAUDIT D
  1.  . S PXLASTEDIT=$P($$LAST^DIAUTL(9999999.28,PXSK,".03"),U,1)
  1.  . I PXDATE>PXLASTEDIT S PXCURR=1
  1.  I PXCURR Q '$P($G(^AUTTSK(PXSK,0)),U,3)
  1.  ;
  1.  S PXSTAT=$P($$GETSTAT^XTID(9999999.28,"",PXSK_",",$G(PXDATE)),U,1)
  1.  I PXSTAT="" S PXSTAT=1
  1.  Q PXSTAT
  1.  ;
  1. GETCSTAT(PXDATE,PXAUDIT) ;
  1.  ;
  1.  ; Should we get current status of SK entries or should we call GETSTAT^XTID
  1.  ; to get status as of a specific date?
  1.  ; Since GETSTAT^XTID is slow, we try to avoid it when possible.
  1.  ;
  1.  ; Returns: 0 - Call GETSTAT^XTID
  1.  ;          1 - Get current status
  1.  ;
  1.  N PXLASTEDITDT,PXRSLT
  1.  ;
  1.  S PXRSLT=0
  1.  ;
  1.  I '$G(PXDATE) D  Q PXRSLT
  1.  . S PXRSLT=1
  1.  ;
  1.  I $P(PXDATE,".",1)=DT D  Q PXRSLT
  1.  . S PXRSLT=1
  1.  ;
  1.  ; If Inactive Flag is being audited (which should be the case)
  1.  ; then get current status, if file has not been updated since PXDATE
  1.  I PXAUDIT D
  1.  . S PXLASTEDITDT=$O(^DIA(9999999.28,"C",""),-1)   ;ICR #2602
  1.  . I PXDATE>PXLASTEDITDT S PXRSLT=1
  1.  ;
  1.  Q PXRSLT
  1.  ;
  1. SKSITES(PXRSLT) ;
  1.  ;
  1.  ; Returns a list of default sites for skin tests.
  1.  ;
  1.  ;Input:
  1.  ;    PXRSLT - Return value passed by reference (Required)
  1.  ;
  1.  ;Returns:
  1.  ;   (0)=Count of elements returned (0 if nothing found)
  1.  ;   (n)=IEN^NAME
  1.  ;   (n)=IEN^NAME
  1.  ;
  1.  N PXCNT,PXIEN,PXSITE,PXSITES
  1.  ;
  1.  ; Try first to get list from parameter
  1.  D GETLST^XPAR(.PXRSLT,"ALL","PXV SKIN TEST ADMIN SITES","N")
  1.  I $G(PXRSLT)>0 D  Q
  1.  . S PXRSLT(0)=PXRSLT
  1.  ;
  1.  ; if parameter is not set, use these sites
  1.  S PXSITES("RA")=""
  1.  S PXSITES("LA")=""
  1.  S PXSITES("RLFA")=""
  1.  S PXSITES("LLFA")=""
  1.  ;
  1.  S PXCNT=0
  1.  ;
  1.  S PXSITE=""
  1.  F  S PXSITE=$O(PXSITES(PXSITE)) Q:PXSITE=""  D
  1.  . S PXIEN=$O(^PXV(920.3,"B",PXSITE,0))
  1.  . I 'PXIEN Q
  1.  . S PXCNT=PXCNT+1
  1.  . S PXRSLT(PXCNT)=PXIEN_U_$P($G(^PXV(920.3,PXIEN,0)),U,1)
  1.  ;
  1.  S PXRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. SKLIST(PXRSLT,DFN,PXSK,PXDATE,PXMAX) ;
  1.  ;
  1.  ; Returns a list of V Skin Test entries that have been placed within the last x days.
  1.  ; The number of days to look back is defined in the PXV SK DAYS BACK parameter.
  1.  ;
  1.  ;Input:
  1.  ;    PXRSLT - Return value passed by reference (Required)
  1.  ;       DFN - Patient's DFN (Required)
  1.  ;             Only V Skin Test entries for this patient will be returned.
  1.  ;      PXSK - Skin Test IEN (Optional)
  1.  ;             If passed in, only V Skin Test entries for this Skin Test will be returned.
  1.  ;             If not passed in, all V Skin Tests entries will be returned.
  1.  ;    PXDATE - Date (Optional; defaults to Today)
  1.  ;             The system will search back x number of days from this date.
  1.  ;     PXMAX - The max number of entries to return per skin test (Optional)
  1.  ;
  1.  ;Returns:
  1.  ;   (0)=Count of elements returned (0 if nothing found)
  1.  ;   (1)=DATERANGE ^ Start Date ^ Stop Date
  1.  ;   (n)=PLACEMENT ^ V Skin Test IEN ^ Skin Test IEN ^ Skin Test Name ^ Date/Time of Placement
  1.  ;
  1.  N PXARR,PXCNT,PXDAYSBACK,PXEVENTDT,PXI,PXNUM,PXSKIEN,PXSTART,PXSTOP,PXVSK0,PXVISIT,PXVSK
  1.  N PXPPDIEN,PXSKNM,PXSORT1
  1.  ;
  1.  S PXCNT=0
  1.  ;
  1.  I '$G(DFN) D  Q
  1.  . S PXRSLT(0)=PXCNT
  1.  I '$G(PXDATE) S PXDATE=DT
  1.  S PXSK=$G(PXSK)
  1.  ;
  1.  S PXPPDIEN=$O(^AUTTSK("B","PPD TUBERCULIN",0))
  1.  I 'PXPPDIEN S PXPPDIEN=$O(^AUTTSK("AVUID",5198083,0))
  1.  ;
  1.  S PXSTOP=$P(PXDATE,".",1)
  1.  S PXDAYSBACK=$$GET^XPAR("ALL","PXV SK DAYS BACK")
  1.  I PXDAYSBACK<1 S PXDAYSBACK=7
  1.  S PXSTART=$P($$FMADD^XLFDT(PXDATE,-PXDAYSBACK),".",1)
  1.  ;
  1.  S PXVSK=0
  1.  F  S PXVSK=$O(^AUPNVSK("C",DFN,PXVSK)) Q:'PXVSK  D
  1.  . S PXVSK0=$G(^AUPNVSK(PXVSK,0))
  1.  . S PXSKIEN=$P(PXVSK0,U,1)
  1.  . I 'PXSKIEN Q
  1.  . I PXSK,PXSK'=PXSKIEN Q
  1.  . ; if both Reading and Results are populated, quit
  1.  . I $P(PXVSK0,U,4)'="",$P(PXVSK0,U,5)'="" Q
  1.  . I $D(^AUPNVSK("APT",PXVSK)) Q
  1.  . S PXEVENTDT=$P($G(^AUPNVSK(PXVSK,12)),U,1)
  1.  . I 'PXEVENTDT D
  1.  . . S PXVISIT=$P(PXVSK0,U,3)
  1.  . . S PXEVENTDT=$P($G(^AUPNVSIT(+PXVISIT,0)),U,1)
  1.  . I 'PXEVENTDT Q
  1.  . I PXEVENTDT<PXSTART Q
  1.  . I PXEVENTDT>(PXSTOP_".24") Q
  1.  . S PXSKNM=$P($G(^AUTTSK(PXSKIEN,0)),U,1)
  1.  . S PXSORT1=PXSKNM
  1.  . ; Sort PPD first
  1.  . I PXSKIEN=PXPPDIEN S PXSORT1="0"_PXSORT1
  1.  . S PXARR(PXSORT1,PXEVENTDT)="PLACEMENT^"_PXVSK_U_PXSKIEN_U_PXSKNM_U_PXEVENTDT
  1.  ;
  1.  S PXCNT=PXCNT+1
  1.  S PXRSLT(PXCNT)="DATERANGE"_U_PXSTART_U_PXSTOP
  1.  ;
  1.  S PXSORT1=""
  1.  F  S PXSORT1=$O(PXARR(PXSORT1)) Q:PXSORT1=""  D
  1.  . S PXNUM=0
  1.  . S PXEVENTDT=""
  1.  . F  S PXEVENTDT=$O(PXARR(PXSORT1,PXEVENTDT),-1) Q:'PXEVENTDT  D
  1.  . . S PXNUM=PXNUM+1
  1.  . . I $G(PXMAX),PXNUM>PXMAX Q
  1.  . . S PXCNT=PXCNT+1
  1.  . . S PXRSLT(PXCNT)=$G(PXARR(PXSORT1,PXEVENTDT))
  1.  ;
  1.  S PXRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. GETCS(PXRSLT,PXCNT,PXSK,PXDATE) ;
  1.  ;
  1.  N PXCODE,PXCODESYS,PXLEX,PXLEXADATE,PXLEXARY,PXLEXIDATE,PXLEXNODE,PXX,PXY
  1.  ;
  1.  S PXDATE=$P(PXDATE,".",1)
  1.  ;
  1.  S PXX=0
  1.  F  S PXX=$O(^AUTTSK(PXSK,3,PXX)) Q:'PXX  D
  1.  . S PXCODESYS=$G(^AUTTSK(PXSK,3,PXX,0))
  1.  . I PXCODESYS="" Q
  1.  . S PXY=0 F  S PXY=$O(^AUTTSK(PXSK,3,PXX,1,PXY)) Q:'PXY  D
  1.  . . S PXCODE=$G(^AUTTSK(PXSK,3,PXX,1,PXY,0))
  1.  . . I PXCODE="" Q
  1.  . . ;
  1.  . . K PXLEXARY
  1.  . . S PXLEX=$$PERIOD^LEXU(PXCODE,PXCODESYS,.PXLEXARY)
  1.  . . ;
  1.  . . I $P(PXLEX,U,1)=-1 D  Q
  1.  . . . I PXCODESYS?1(1"CPT",1"10D") Q
  1.  . . . S PXCNT=PXCNT+1
  1.  . . . S PXRSLT(PXCNT)="CS^"_PXCODESYS_U_PXCODE
  1.  . . ;
  1.  . . S PXLEXADATE=$O(PXLEXARY((PXDATE+.00001)),-1)
  1.  . . I PXLEXADATE="" Q
  1.  . . S PXLEXNODE=$G(PXLEXARY(PXLEXADATE))
  1.  . . S PXLEXIDATE=$P(PXLEXNODE,U,1)
  1.  . . I PXLEXIDATE,PXDATE>PXLEXIDATE Q
  1.  . . S PXCNT=PXCNT+1
  1.  . . S PXRSLT(PXCNT)="CS^"_PXCODESYS_U_PXCODE_U_$P(PXLEXNODE,U,3)_U_$P(PXLEXNODE,U,4)
  1.  ;
  1.  Q
  1.  ;
  1. GETSKCD(PXRSLT,PXSK,PXDATE) ;
  1.  ;
  1.  N PXCNT,PXCODE,PXCODES,PXCODESYS,PXI,PXLEX,PXLEXADATE,PXLEXARY,PXLEXIDATE,PXLEXNODE
  1.  I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
  1.  S PXCNT=0
  1.  D GETCS(.PXCODES,.PXCNT,PXSK,PXDATE)
  1.  ;
  1.  F PXI=1:1:PXCNT D
  1.  . S PXCODESYS=$P($G(PXCODES(PXI)),U,2)
  1.  . S PXRSLT(PXI)=$P($G(PXCODES(PXI)),U,2,5)_U_$S(PXCODESYS="CPT":"P",1:"B")
  1.  ;
  1.  S PXCODE=$$GET^XPAR("ALL","PXV SKIN TEST READING CPT",1,"I")
  1.  I PXCODE="" Q
  1.  S PXCODESYS="CPT"
  1.  K PXLEXARY
  1.  S PXLEX=$$PERIOD^LEXU(PXCODE,PXCODESYS,.PXLEXARY)
  1.  I $P(PXLEX,U,1)=-1 Q
  1.  S PXLEXADATE=$O(PXLEXARY((PXDATE+.00001)),-1)
  1.  I PXLEXADATE="" Q
  1.  S PXLEXNODE=$G(PXLEXARY(PXLEXADATE))
  1.  S PXLEXIDATE=$P(PXLEXNODE,U,1)
  1.  I PXLEXIDATE,PXDATE>PXLEXIDATE Q
  1.  S PXCNT=PXCNT+1
  1.  S PXRSLT(PXCNT)=PXCODESYS_U_PXCODE_U_$P(PXLEXNODE,U,3)_U_$P(PXLEXNODE,U,4)_U_"R"
  1.  ;
  1.  Q