BKMRMED.m

BKMRMED ;PRXM/HC/ALA-HMS Education Reminders ; 13 Nov 2007  4:03 PM

 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

ED01(GUI) ;EP - REM.ED.01

 ; Safe Sex Education Due

 ; Numerator: All patients, ages 13 and older.

 ; Due date = Today, if patients have not had Safe Sex Education (ED.3) ever documented. OR

 ; Due date = Last documented education date + 183 days (or 6 months)

 ; If "Now," then text = "Safe Sex Education may be due now; last documented [date]."

 NEW LAST,DUE,LIST

 S GUI=$G(GUI,0)

 S (LAST,DUE)=""

 I APCHSAGE'<13 D

 . D PTEDTAX^BKMIXX1(DFN,"BKM SAFE SEX ED CODES","","","",.LAST)

 . I LAST'="" S DUE=+$$SCH^XLFDT("6M",LAST)

 . I LAST="" S DUE=DT

 D ADDLINE^BKMVF32("31 REM.ED.01",.LIST,"Safe Sex Educ",LAST,DUE)

 D WRITE("31 REM.ED.01",GUI)

 Q

 ;

ED02(GUI) ;EP - REM.ED.02

 ; Family Planning Education Due

 ; Numerator: All female patients, ages 13 - 44 and all male patients ages 13 and older.

 ; Due date = Today, if patients have not had Family Planning Education (ED.1) ever documented. OR

 ; Due date = Last documented education date + 183 days (or 6 months)

 ; If "Now," then text = "Family Planning Education may be due now; last documented [date]."

 NEW LAST,DUE,LAST1,LIST

 S GUI=$G(GUI,0)

 S (LAST,DUE,LAST1)=""

 I (APCHSEX="F"&(APCHSAGE'<13)&(APCHSAGE'>44))!(APCHSEX="M"&(APCHSAGE'<13)) D

 . D PTEDTAX^BKMIXX(DFN,"FP-","","","",.LAST)

 . D ICDTAX^BKMIXX1(DFN,"BKM FAMILY PLANNING POV","","","",.LAST1)

 . S LAST=$S(LAST>LAST1:LAST,1:LAST1)

 . I LAST'="" S DUE=+$$SCH^XLFDT("6M",LAST)

 . I LAST="" S DUE=DT

 D ADDLINE^BKMVF32("32 REM.ED.02",.LIST,"Family Planning Educ",LAST,DUE)

 D WRITE("32 REM.ED.02",GUI)

 Q

 ;

WRITE(REM,GUI) ;  Write out the reminder

 S APCHLAST=$G(LIST(REM,1,"LAST"))

 I APCHLAST="" S APCHSTEX(1)="MAY BE DUE NOW"

 S APCHNEXT=$G(LIST(REM,1,"DUE"))

 I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 I APCHNEXT'>DT S APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"

 I 'GUI D WRITE^APCHSMU

 I GUI S REMLAST=APCHLAST,REMNEXT=$G(APCHSTEX(1)),REMDUE=APCHNEXT

 K APCHLAST,APCHNEXT,APCHSTEX,LIST

 Q

BKMRMED   ;PRXM/HC/ALA-HMS Education Reminders ; 13 Nov 2007  4:03 PM

 +1       ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

ED01(GUI) ;EP - REM.ED.01

 +1       ; Safe Sex Education Due

 +2       ; Numerator: All patients, ages 13 and older.

 +3       ; Due date = Today, if patients have not had Safe Sex Education (ED.3) ever documented. OR

 +4       ; Due date = Last documented education date + 183 days (or 6 months)

 +5       ; If "Now," then text = "Safe Sex Education may be due now; last documented [date]."

 +6        NEW LAST,DUE,LIST

 +7        SET GUI=$GET(GUI,0)

 +8        SET (LAST,DUE)=""

 +9        IF APCHSAGE'<13

               Begin DoDot:1

 +10               DO PTEDTAX^BKMIXX1(DFN,"BKM SAFE SEX ED CODES","","","",.LAST)

 +11               IF LAST'=""

                       SET DUE=+$$SCH^XLFDT("6M",LAST)

 +12               IF LAST=""

                       SET DUE=DT

               End DoDot:1

 +13       DO ADDLINE^BKMVF32("31 REM.ED.01",.LIST,"Safe Sex Educ",LAST,DUE)

 +14       DO WRITE("31 REM.ED.01",GUI)

 +15       QUIT 

 +16      ;

ED02(GUI) ;EP - REM.ED.02

 +1       ; Family Planning Education Due

 +2       ; Numerator: All female patients, ages 13 - 44 and all male patients ages 13 and older.

 +3       ; Due date = Today, if patients have not had Family Planning Education (ED.1) ever documented. OR

 +4       ; Due date = Last documented education date + 183 days (or 6 months)

 +5       ; If "Now," then text = "Family Planning Education may be due now; last documented [date]."

 +6        NEW LAST,DUE,LAST1,LIST

 +7        SET GUI=$GET(GUI,0)

 +8        SET (LAST,DUE,LAST1)=""

 +9        IF (APCHSEX="F"&(APCHSAGE'<13)&(APCHSAGE'>44))!(APCHSEX="M"&(APCHSAGE'<13))

               Begin DoDot:1

 +10               DO PTEDTAX^BKMIXX(DFN,"FP-","","","",.LAST)

 +11               DO ICDTAX^BKMIXX1(DFN,"BKM FAMILY PLANNING POV","","","",.LAST1)

 +12               SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)

 +13               IF LAST'=""

                       SET DUE=+$$SCH^XLFDT("6M",LAST)

 +14               IF LAST=""

                       SET DUE=DT

               End DoDot:1

 +15       DO ADDLINE^BKMVF32("32 REM.ED.02",.LIST,"Family Planning Educ",LAST,DUE)

 +16       DO WRITE("32 REM.ED.02",GUI)

 +17       QUIT 

 +18      ;

WRITE(REM,GUI) ;  Write out the reminder

 +1        SET APCHLAST=$GET(LIST(REM,1,"LAST"))

 +2        IF APCHLAST=""

               SET APCHSTEX(1)="MAY BE DUE NOW"

 +3        SET APCHNEXT=$GET(LIST(REM,1,"DUE"))

 +4        IF APCHNEXT>DT

               SET APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 +5        IF APCHNEXT'>DT

               SET APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"

 +6        IF 'GUI

               DO WRITE^APCHSMU

 +7        IF GUI

               SET REMLAST=APCHLAST

               SET REMNEXT=$GET(APCHSTEX(1))

               SET REMDUE=APCHNEXT

 +8        KILL APCHLAST,APCHNEXT,APCHSTEX,LIST

 +9        QUIT