BTPWPLN1.m

BTPWPLN1 ;GDIT/HCS/ALA-Planned Events continuation ; 02 Mar 2017  8:17 AM

 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71

 ;

 ;

SNG(CMIEN,COMM,RESULT) ; Get the basic record information for a single record

 ; The Planned Events Tab includes the following columns: Category, Patient Name, 

 ; HRN, DOB, Age, Sex, Community, Planned Event Name, Planned Event Date, Preceding Event (Y/N)

 N DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,HRN,DOB,AGE,SEX,PRVDT,DUEDT,PREV,PRVEVT,ORD,ORDYN,ORDNM,ORDDT

 S TDATA=$G(^BTPWP(CMIEN,0)),DFN=$P(TDATA,U,2),PCOM="",PNAM=$P(^DPT(DFN,0),"^")

 ;

 ;Community check

 S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")

 I COMM'="",PCOM'="",'$D(COMM(PCOM)) S RESULT="" Q

 I PCOM'="" S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")  ;Community

 ;

 S PROC=$P(TDATA,U),PROCNM=$P(^BTPW(90621,PROC,0),U)  ;Procedure/Name (Event)

 S CAT=$$CAT^BTPWPDSP(PROC)  ;Category

 S HRN=$TR($$HRNL^BQIULPT(DFN),";",$C(10))   ;HRN

 S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I")) ;DOB

 S AGE=$$AGE^BQIAGE(DFN,,1)  ;Age

 S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")  ;Sex

 S DUEDT=$$FMTE^BQIUL1($P(TDATA,U,13))  ;due by date

 S PREV=$P(TDATA,U,11)  ;Previous event

 S (PRVDT,PRVEVT)="" I PREV]"" S PRVDT=$$GET1^DIQ(90620,PREV_",",".03","I"),PRVDT=$$FMTE^BQIUL1(PRVDT),PRVEVT=$$GET1^DIQ(90620,PREV_",",".01","E") ;Prv DT

 S ORD=$$GET1^DIQ(90621,PROC_",",.11,"I")

 I ORD]"" S ORD=$$ORD^BTPWPPAT(DFN,ORD)

 S ORDYN=$S(ORD]"":"Y",1:"")

 S ORDNM=$P(ORD,U)

 S ORDDT=$$FMTE^BQIUL1($P(ORD,U,2))

 ;

 S RESULT=CMIEN_U_CAT_U_DFN_U_$$SENS^BQIULPT(DFN)_U_PNAM_U_HRN_U_DOB_U_AGE_U_SEX_U_$$CALR^BQIULPT(DFN)_U_PCOM_U_PROCNM_U_DUEDT_U_PRVDT_U_PREV_U_PRVEVT_U_ORDYN_U_ORDNM_U_ORDDT

 Q

BTPWPLN1  ;GDIT/HCS/ALA-Planned Events continuation ; 02 Mar 2017  8:17 AM

 +1       ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71

 +2       ;

 +3       ;

SNG(CMIEN,COMM,RESULT) ; Get the basic record information for a single record

 +1       ; The Planned Events Tab includes the following columns: Category, Patient Name, 

 +2       ; HRN, DOB, Age, Sex, Community, Planned Event Name, Planned Event Date, Preceding Event (Y/N)

 +3        NEW DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,HRN,DOB,AGE,SEX,PRVDT,DUEDT,PREV,PRVEVT,ORD,ORDYN,ORDNM,ORDDT

 +4        SET TDATA=$GET(^BTPWP(CMIEN,0))

           SET DFN=$PIECE(TDATA,U,2)

           SET PCOM=""

           SET PNAM=$PIECE(^DPT(DFN,0),"^")

 +5       ;

 +6       ;Community check

 +7        SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")

 +8        IF COMM'=""

               IF PCOM'=""

                   IF '$DATA(COMM(PCOM))

                       SET RESULT=""

                       QUIT 

 +9       ;Community

           IF PCOM'=""

               SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")

 +10      ;

 +11      ;Procedure/Name (Event)

           SET PROC=$PIECE(TDATA,U)

           SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U)

 +12      ;Category

           SET CAT=$$CAT^BTPWPDSP(PROC)

 +13      ;HRN

           SET HRN=$TRANSLATE($$HRNL^BQIULPT(DFN),";",$CHAR(10))

 +14      ;DOB

           SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))

 +15      ;Age

           SET AGE=$$AGE^BQIAGE(DFN,,1)

 +16      ;Sex

           SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")

 +17      ;due by date

           SET DUEDT=$$FMTE^BQIUL1($PIECE(TDATA,U,13))

 +18      ;Previous event

           SET PREV=$PIECE(TDATA,U,11)

 +19      ;Prv DT

           SET (PRVDT,PRVEVT)=""

           IF PREV]""

               SET PRVDT=$$GET1^DIQ(90620,PREV_",",".03","I")

               SET PRVDT=$$FMTE^BQIUL1(PRVDT)

               SET PRVEVT=$$GET1^DIQ(90620,PREV_",",".01","E")

 +20       SET ORD=$$GET1^DIQ(90621,PROC_",",.11,"I")

 +21       IF ORD]""

               SET ORD=$$ORD^BTPWPPAT(DFN,ORD)

 +22       SET ORDYN=$SELECT(ORD]"":"Y",1:"")

 +23       SET ORDNM=$PIECE(ORD,U)

 +24       SET ORDDT=$$FMTE^BQIUL1($PIECE(ORD,U,2))

 +25      ;

 +26       SET RESULT=CMIEN_U_CAT_U_DFN_U_$$SENS^BQIULPT(DFN)_U_PNAM_U_HRN_U_DOB_U_AGE_U_SEX_U_$$CALR^BQIULPT(DFN)_U_PCOM_U_PROCNM_U_DUEDT_U_PRVDT_U_PREV_U_PRVEVT_U_ORDYN_U_ORDNM_U_ORDDT

 +27       QUIT