- 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 Jan 18, 2025@03:52:48 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