DGPTFAPI ;BAY/JAT/ADL,HIOFO/FT - Returns data from Patient Treatment (PTF) file ;10/8/14 12:38pm
;;5.3;Registration;**309,510,850,884**;Aug 13, 1993;Build 31
;;ADL;Update for CSV Project;;Mar 24, 2003
;
;uses ICRs:
; ICDEX APIs - #5747
;
;supports ICRs:
; RPC entry point #3157 (routine usage)
; RPC entry point #3164 (remote procedure usage)
;
RPC(RESULTS,PTFNUMBR) ;DG PATIENT TREATMENT DATA rpc
; input : PTFNUMBR, the Patient Treatment IFN (.001 of file #45)
; RESULTS (passed by reference)
; output: RESULTS(0) = 1 (entry found) OR -1 (error)
; RESULTS(1) = #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
; RESULTS(2) = DX 2^DX 3^...^DX 24
; RESULTS(3) = POA 1^POA 2^...^POA 25
N DGPTF,DG70,DG71,DGDISP,DGDXE,DGDXI,DGDXLS,DGDISTYP,DGLOOP,DGNODE,DGPOA,DGPTDAT,DXLS,EFFDATE,ICDVER,IMPDATE
S DGPTF=$G(PTFNUMBR)
S ICDVER=""
K RESULTS S RESULTS(0)=-1
I 'DGPTF Q
I '$D(^DGPT(DGPTF,0)) Q
S DG70=$G(^DGPT(DGPTF,70)),DG71=$G(^DGPT(DGPTF,71)),DGPOA=$G(^DGPT(DGPTF,82))
S DGDISP=$P(DG70,U,6)
I DGDISP S DGDISP=$P($G(^DIC(45.6,DGDISP,0)),U)
S DGDISTYP=$P(DG70,U,3)
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:"")
S DGDXLS=$P(DG70,U,10)
S DGPTDAT=$$GETDATE^ICDEX(DGPTF)
D EFFDATE^DGPTIC10(DGPTF)
I DGDXLS S DXLS=$$CODEC^ICDEX(80,DGDXLS),ICDVER=$$CSI^ICDEX(80,DGDXLS)
S RESULTS(0)=1
; #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
S RESULTS(1)=DGDISTYP_U_DGDISP_U_$G(DXLS)_U_$G(ICDVER)
; get secondary DXs: #79.16 - #79.24 and #79.241 - #79.24915
S DGNODE="",RESULTS(2)="^^^^^^^^^^^^^^^^^^^^^^^^"
F DGLOOP=16:1:24 S $P(DGNODE,U,DGLOOP-15)=$P(DG70,U,DGLOOP)
F DGLOOP=1:1:15 S $P(DGNODE,U,DGLOOP+9)=$P(DG71,U,DGLOOP)
F DGLOOP=1:1:24 D
. S DGDXI=$P(DGNODE,U,DGLOOP)
. I DGDXI S DGDXE=$$CODEC^ICDEX(80,DGDXI) D
.. S $P(RESULTS(2),U,DGLOOP)=DGDXE
; get the POA indicator for diagnosis, #82.01 - #82.25
S RESULTS(3)=""
F DGLOOP=1:1:25 D
. S $P(RESULTS(3),U,DGLOOP)=$P(DGPOA,U,DGLOOP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFAPI 2347 printed Sep 23, 2025@20:27:59 Page 2
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
+2 ;;ADL;Update for CSV Project;;Mar 24, 2003
+3 ;
+4 ;uses ICRs:
+5 ; ICDEX APIs - #5747
+6 ;
+7 ;supports ICRs:
+8 ; RPC entry point #3157 (routine usage)
+9 ; RPC entry point #3164 (remote procedure usage)
+10 ;
RPC(RESULTS,PTFNUMBR) ;DG PATIENT TREATMENT DATA rpc
+1 ; input : PTFNUMBR, the Patient Treatment IFN (.001 of file #45)
+2 ; RESULTS (passed by reference)
+3 ; output: RESULTS(0) = 1 (entry found) OR -1 (error)
+4 ; RESULTS(1) = #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
+5 ; RESULTS(2) = DX 2^DX 3^...^DX 24
+6 ; RESULTS(3) = POA 1^POA 2^...^POA 25
+7 NEW DGPTF,DG70,DG71,DGDISP,DGDXE,DGDXI,DGDXLS,DGDISTYP,DGLOOP,DGNODE,DGPOA,DGPTDAT,DXLS,EFFDATE,ICDVER,IMPDATE
+8 SET DGPTF=$GET(PTFNUMBR)
+9 SET ICDVER=""
+10 KILL RESULTS
SET RESULTS(0)=-1
+11 IF 'DGPTF
QUIT
+12 IF '$DATA(^DGPT(DGPTF,0))
QUIT
+13 SET DG70=$GET(^DGPT(DGPTF,70))
SET DG71=$GET(^DGPT(DGPTF,71))
SET DGPOA=$GET(^DGPT(DGPTF,82))
+14 SET DGDISP=$PIECE(DG70,U,6)
+15 IF DGDISP
SET DGDISP=$PIECE($GET(^DIC(45.6,DGDISP,0)),U)
+16 SET DGDISTYP=$PIECE(DG70,U,3)
+17 IF DGDISTYP
SET DGDISTYP=$SELECT(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:"")
+18 SET DGDXLS=$PIECE(DG70,U,10)
+19 SET DGPTDAT=$$GETDATE^ICDEX(DGPTF)
+20 DO EFFDATE^DGPTIC10(DGPTF)
+21 IF DGDXLS
SET DXLS=$$CODEC^ICDEX(80,DGDXLS)
SET ICDVER=$$CSI^ICDEX(80,DGDXLS)
+22 SET RESULTS(0)=1
+23 ; #72: type of disposition^#75: place of disposition (name)^#79: primary ICD code^Coding system Version (pointer to 80.4)
+24 SET RESULTS(1)=DGDISTYP_U_DGDISP_U_$GET(DXLS)_U_$GET(ICDVER)
+25 ; get secondary DXs: #79.16 - #79.24 and #79.241 - #79.24915
+26 SET DGNODE=""
SET RESULTS(2)="^^^^^^^^^^^^^^^^^^^^^^^^"
+27 FOR DGLOOP=16:1:24
SET $PIECE(DGNODE,U,DGLOOP-15)=$PIECE(DG70,U,DGLOOP)
+28 FOR DGLOOP=1:1:15
SET $PIECE(DGNODE,U,DGLOOP+9)=$PIECE(DG71,U,DGLOOP)
+29 FOR DGLOOP=1:1:24
Begin DoDot:1
+30 SET DGDXI=$PIECE(DGNODE,U,DGLOOP)
+31 IF DGDXI
SET DGDXE=$$CODEC^ICDEX(80,DGDXI)
Begin DoDot:2
+32 SET $PIECE(RESULTS(2),U,DGLOOP)=DGDXE
End DoDot:2
End DoDot:1
+33 ; get the POA indicator for diagnosis, #82.01 - #82.25
+34 SET RESULTS(3)=""
+35 FOR DGLOOP=1:1:25
Begin DoDot:1
+36 SET $PIECE(RESULTS(3),U,DGLOOP)=$PIECE(DGPOA,U,DGLOOP)
End DoDot:1
+37 QUIT
