DGPTFAPI.m

DGPTFAPI ;BAY/JAT/ADL - Returns data from Patient Treatment (PTF) file; ; 10/12/00 10:00am

 ;;5.3;Registration;**309,510,1015**;Aug 13, 1993;Build 21

 ;;ADL;Update for CSV Project;;Mar 24, 2003

 ; can be used as an RPC (Remote Procedure call)

 ; see ^XWB(8994 for documentation

 ; output:  RESULTS (passed by reference)

 ; input :  PTFNUMBR, the Patient Treatment IFN (.001 of file #45)

 ;

RPC(RESULTS,PTFNUMBR) ;

 N DGPTF,DG70,DGDISP,DGDXLS,DGDX2,DGDX3,DGDX4,DGDX5,DGDX6,DGDX7,DGDX8,DGDX9,DGDX10,DGDISTYP

 S DGPTF=$G(PTFNUMBR)

 K RESULTS S RESULTS(0)=-1

 I 'DGPTF Q

 I '$D(^DGPT(DGPTF,0)) Q

 S DG70=$G(^DGPT(DGPTF,70))

 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^ICDGTDRG(DGPTF)

 I DGDXLS S DGDXLS=$P($$ICDDX^ICDCODE(DGDXLS,DGPTDAT),U,2)

 S DGDX2=$P(DG70,U,16) I DGDX2 S DGDX2=$P($$ICDDX^ICDCODE(DGDX2,DGPTDAT),U,2)

 S DGDX3=$P(DG70,U,17) I DGDX3 S DGDX3=$P($$ICDDX^ICDCODE(DGDX3,DGPTDAT),U,2)

 S DGDX4=$P(DG70,U,18) I DGDX4 S DGDX4=$P($$ICDDX^ICDCODE(DGDX4,DGPTDAT),U,2)

 S DGDX5=$P(DG70,U,19) I DGDX5 S DGDX5=$P($$ICDDX^ICDCODE(DGDX5,DGPTDAT),U,2)

 S DGDX6=$P(DG70,U,20) I DGDX6 S DGDX6=$P($$ICDDX^ICDCODE(DGDX6,DGPTDAT),U,2)

 S DGDX7=$P(DG70,U,21) I DGDX7 S DGDX7=$P($$ICDDX^ICDCODE(DGDX7,DGPTDAT),U,2)

 S DGDX8=$P(DG70,U,22) I DGDX8 S DGDX8=$P($$ICDDX^ICDCODE(DGDX8,DGPTDAT),U,2)

 S DGDX9=$P(DG70,U,23) I DGDX9 S DGDX9=$P($$ICDDX^ICDCODE(DGDX9,DGPTDAT),U,2)

 S DGDX10=$P(DG70,U,24) I DGDX10 S DGDX10=$P($$ICDDX^ICDCODE(DGDX10,DGPTDAT),U,2)

 S RESULTS(0)=1

 ; #72: type of disposition^#75: place of disposition (name)^#79: primary ICD9 code

 S RESULTS(1)=DGDISTYP_U_DGDISP_U_DGDXLS

 ; #79.16 thru 79.24: 2nd thru 10th ICD9 codes

 S RESULTS(2)=DGDX2_U_DGDX3_U_DGDX4_U_DGDX5_U_DGDX6_U_DGDX7_U_DGDX8_U_DGDX9_U_DGDX10

 Q

DGPTFAPI  ;BAY/JAT/ADL - Returns data from Patient Treatment (PTF) file; ; 10/12/00 10:00am

 +1       ;;5.3;Registration;**309,510,1015**;Aug 13, 1993;Build 21

 +2       ;;ADL;Update for CSV Project;;Mar 24, 2003

 +3       ; can be used as an RPC (Remote Procedure call)

 +4       ; see ^XWB(8994 for documentation

 +5       ; output:  RESULTS (passed by reference)

 +6       ; input :  PTFNUMBR, the Patient Treatment IFN (.001 of file #45)

 +7       ;

RPC(RESULTS,PTFNUMBR) ;

 +1        NEW DGPTF,DG70,DGDISP,DGDXLS,DGDX2,DGDX3,DGDX4,DGDX5,DGDX6,DGDX7,DGDX8,DGDX9,DGDX10,DGDISTYP

 +2        SET DGPTF=$GET(PTFNUMBR)

 +3        KILL RESULTS

           SET RESULTS(0)=-1

 +4        IF 'DGPTF

               QUIT 

 +5        IF '$DATA(^DGPT(DGPTF,0))

               QUIT 

 +6        SET DG70=$GET(^DGPT(DGPTF,70))

 +7        SET DGDISP=$PIECE(DG70,U,6)

 +8        IF DGDISP

               SET DGDISP=$PIECE($GET(^DIC(45.6,DGDISP,0)),U)

 +9        SET DGDISTYP=$PIECE(DG70,U,3)

 +10       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:"")

 +11       SET DGDXLS=$PIECE(DG70,U,10)

 +12       SET DGPTDAT=$$GETDATE^ICDGTDRG(DGPTF)

 +13       IF DGDXLS

               SET DGDXLS=$PIECE($$ICDDX^ICDCODE(DGDXLS,DGPTDAT),U,2)

 +14       SET DGDX2=$PIECE(DG70,U,16)

           IF DGDX2

               SET DGDX2=$PIECE($$ICDDX^ICDCODE(DGDX2,DGPTDAT),U,2)

 +15       SET DGDX3=$PIECE(DG70,U,17)

           IF DGDX3

               SET DGDX3=$PIECE($$ICDDX^ICDCODE(DGDX3,DGPTDAT),U,2)

 +16       SET DGDX4=$PIECE(DG70,U,18)

           IF DGDX4

               SET DGDX4=$PIECE($$ICDDX^ICDCODE(DGDX4,DGPTDAT),U,2)

 +17       SET DGDX5=$PIECE(DG70,U,19)

           IF DGDX5

               SET DGDX5=$PIECE($$ICDDX^ICDCODE(DGDX5,DGPTDAT),U,2)

 +18       SET DGDX6=$PIECE(DG70,U,20)

           IF DGDX6

               SET DGDX6=$PIECE($$ICDDX^ICDCODE(DGDX6,DGPTDAT),U,2)

 +19       SET DGDX7=$PIECE(DG70,U,21)

           IF DGDX7

               SET DGDX7=$PIECE($$ICDDX^ICDCODE(DGDX7,DGPTDAT),U,2)

 +20       SET DGDX8=$PIECE(DG70,U,22)

           IF DGDX8

               SET DGDX8=$PIECE($$ICDDX^ICDCODE(DGDX8,DGPTDAT),U,2)

 +21       SET DGDX9=$PIECE(DG70,U,23)

           IF DGDX9

               SET DGDX9=$PIECE($$ICDDX^ICDCODE(DGDX9,DGPTDAT),U,2)

 +22       SET DGDX10=$PIECE(DG70,U,24)

           IF DGDX10

               SET DGDX10=$PIECE($$ICDDX^ICDCODE(DGDX10,DGPTDAT),U,2)

 +23       SET RESULTS(0)=1

 +24      ; #72: type of disposition^#75: place of disposition (name)^#79: primary ICD9 code

 +25       SET RESULTS(1)=DGDISTYP_U_DGDISP_U_DGDXLS

 +26      ; #79.16 thru 79.24: 2nd thru 10th ICD9 codes

 +27       SET RESULTS(2)=DGDX2_U_DGDX3_U_DGDX4_U_DGDX5_U_DGDX6_U_DGDX7_U_DGDX8_U_DGDX9_U_DGDX10

 +28       QUIT