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

DGPTFAPI.m

Go to the documentation of this file.
  1. DGPTFAPI ;BAY/JAT/ADL,HIOFO/FT - Returns data from Patient Treatment (PTF) file ;10/8/14 12:38pm
  1. ;;5.3;Registration;**309,510,850,884**;Aug 13, 1993;Build 31
  1. ;;ADL;Update for CSV Project;;Mar 24, 2003
  1. ;
  1. ;uses ICRs:
  1. ; ICDEX APIs - #5747
  1. ;
  1. ;supports ICRs:
  1. ; RPC entry point #3157 (routine usage)
  1. ; RPC entry point #3164 (remote procedure usage)
  1. ;
  1. RPC(RESULTS,PTFNUMBR) ;DG PATIENT TREATMENT DATA rpc
  1. ; input : PTFNUMBR, the Patient Treatment IFN (.001 of file #45)
  1. ; RESULTS (passed by reference)
  1. ; output: RESULTS(0) = 1 (entry found) OR -1 (error)
  1. ; RESULTS(1) = #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
  1. ; RESULTS(2) = DX 2^DX 3^...^DX 24
  1. ; RESULTS(3) = POA 1^POA 2^...^POA 25
  1. N DGPTF,DG70,DG71,DGDISP,DGDXE,DGDXI,DGDXLS,DGDISTYP,DGLOOP,DGNODE,DGPOA,DGPTDAT,DXLS,EFFDATE,ICDVER,IMPDATE
  1. S DGPTF=$G(PTFNUMBR)
  1. S ICDVER=""
  1. K RESULTS S RESULTS(0)=-1
  1. I 'DGPTF Q
  1. I '$D(^DGPT(DGPTF,0)) Q
  1. S DG70=$G(^DGPT(DGPTF,70)),DG71=$G(^DGPT(DGPTF,71)),DGPOA=$G(^DGPT(DGPTF,82))
  1. S DGDISP=$P(DG70,U,6)
  1. I DGDISP S DGDISP=$P($G(^DIC(45.6,DGDISP,0)),U)
  1. S DGDISTYP=$P(DG70,U,3)
  1. I DGDISTYP S DGDISTYP=$S(DGDISTYP=1:"REGULAR",DGDISTYP=2:"NBC OR WHILE ASIH",DGDISTYP=3:"EXPIRATION 6 MONTH LIMIT",DGDISTYP=4:"IRREGULAR",DGDISTYP=5:"TRANSFER",DGDISTYP=6:"DEATH WITH AUTOPSY",DGDISTYP=7:"DEATH WITHOUT AUTOPSY",1:"")
  1. S DGDXLS=$P(DG70,U,10)
  1. S DGPTDAT=$$GETDATE^ICDEX(DGPTF)
  1. D EFFDATE^DGPTIC10(DGPTF)
  1. I DGDXLS S DXLS=$$CODEC^ICDEX(80,DGDXLS),ICDVER=$$CSI^ICDEX(80,DGDXLS)
  1. S RESULTS(0)=1
  1. ; #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
  1. S RESULTS(1)=DGDISTYP_U_DGDISP_U_$G(DXLS)_U_$G(ICDVER)
  1. ; get secondary DXs: #79.16 - #79.24 and #79.241 - #79.24915
  1. S DGNODE="",RESULTS(2)="^^^^^^^^^^^^^^^^^^^^^^^^"
  1. F DGLOOP=16:1:24 S $P(DGNODE,U,DGLOOP-15)=$P(DG70,U,DGLOOP)
  1. F DGLOOP=1:1:15 S $P(DGNODE,U,DGLOOP+9)=$P(DG71,U,DGLOOP)
  1. F DGLOOP=1:1:24 D
  1. . S DGDXI=$P(DGNODE,U,DGLOOP)
  1. . I DGDXI S DGDXE=$$CODEC^ICDEX(80,DGDXI) D
  1. .. S $P(RESULTS(2),U,DGLOOP)=DGDXE
  1. ; get the POA indicator for diagnosis, #82.01 - #82.25
  1. S RESULTS(3)=""
  1. F DGLOOP=1:1:25 D
  1. . S $P(RESULTS(3),U,DGLOOP)=$P(DGPOA,U,DGLOOP)
  1. Q