BKMVA61.m

BKMVA61 ;PRXM/HC/JGH - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 09 Jun 2005  12:57 PM

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

 ;

 Q

 ;

EN ;ENTRY POINT -- ListMan template BKMV PCC EDUC REVIEW

 ; Assumes existence of DFN,DUZ

 N HIVIEN

 S HIVIEN=$$HIVIEN^BKMIXX3()

 I HIVIEN="" W !,"There is no HMS register defined." H 2 Q

 I '$$VALID^BKMIXX3(DUZ) Q

 K ^TMP("BKMVA61",$J)

 D ^XBFMK

 D EN^VALM("BKMV PCC EDUC REVIEW")

 D ^XBFMK

 Q

 ;

HDR ; -- header code

 ; Assumes existence of DUZ

 D HDR^BKMVA51

 Q

 ;

INIT ; -- init variables and list array

 ; Assumes existence of DFN

 D GETALL(DFN)

 Q

 ;

GETALL(DFN) ; Build ListMan display array of patient education information

 ; Input variables:

 ;  DFN - IEN for File 2

 ; Output variables:

 ;  VALMAR - Builds ListMan array

 ;  VALMCNT - List array count

 ;  VALM0

 N TEXT,PEDIEN,IENS,PEDDT,RPEDDT,PPEDDT

 D ^XBFMK

 S VALMCNT=0,VALMAR="^TMP(""BKMVA61"","""_$J_""")",VALM0=""

 ;

 S (RPEDDT,PPEDDT)=""

 F  S RPEDDT=$O(^AUPNVPED("AA",DFN,RPEDDT)) Q:RPEDDT=""  D

 . S PEDIEN=""

 . F  S PEDIEN=$O(^AUPNVPED("AA",DFN,RPEDDT,PEDIEN)) Q:PEDIEN=""  D

 . . S DA=PEDIEN

 . . S PEDDT=9999999-RPEDDT

 . . S IENS=$$IENS^DILF(.DA)

 . . S TEXT=""

 . . S TEXT=$$SETFLD^VALM1($S(PEDDT'=PPEDDT:$$FMTE^XLFDT(PEDDT,"5Z"),1:""),TEXT,"Visit")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".01","E"),TEXT,"Class")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".06","E"),TEXT,"Level")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".05","E"),TEXT,"Provider")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".14","E"),TEXT,"Objs Met")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".07","E"),TEXT,"I/G")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".08","E"),TEXT,"Len")

 . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".13","I"),TEXT,"Beh")

 . . S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)

 . . S PPEDDT=PEDDT

 D ^XBFMK

 Q

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !

 Q

 ;

EXIT ;

 K ^TMP("BKMVA61",$J)

 K VALM0,VALMAR,VALMHDR,VALMCNT

 Q

 ;

 ;

BKMVA61   ;PRXM/HC/JGH - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 09 Jun 2005  12:57 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN        ;ENTRY POINT -- ListMan template BKMV PCC EDUC REVIEW

 +1       ; Assumes existence of DFN,DUZ

 +2        NEW HIVIEN

 +3        SET HIVIEN=$$HIVIEN^BKMIXX3()

 +4        IF HIVIEN=""

               WRITE !,"There is no HMS register defined."

               HANG 2

               QUIT 

 +5        IF '$$VALID^BKMIXX3(DUZ)

               QUIT 

 +6        KILL ^TMP("BKMVA61",$JOB)

 +7        DO ^XBFMK

 +8        DO EN^VALM("BKMV PCC EDUC REVIEW")

 +9        DO ^XBFMK

 +10       QUIT 

 +11      ;

HDR       ; -- header code

 +1       ; Assumes existence of DUZ

 +2        DO HDR^BKMVA51

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1       ; Assumes existence of DFN

 +2        DO GETALL(DFN)

 +3        QUIT 

 +4       ;

GETALL(DFN) ; Build ListMan display array of patient education information

 +1       ; Input variables:

 +2       ;  DFN - IEN for File 2

 +3       ; Output variables:

 +4       ;  VALMAR - Builds ListMan array

 +5       ;  VALMCNT - List array count

 +6       ;  VALM0

 +7        NEW TEXT,PEDIEN,IENS,PEDDT,RPEDDT,PPEDDT

 +8        DO ^XBFMK

 +9        SET VALMCNT=0

           SET VALMAR="^TMP(""BKMVA61"","""_$JOB_""")"

           SET VALM0=""

 +10      ;

 +11       SET (RPEDDT,PPEDDT)=""

 +12       FOR 

               SET RPEDDT=$ORDER(^AUPNVPED("AA",DFN,RPEDDT))

               IF RPEDDT=""

                   QUIT 

               Begin DoDot:1

 +13               SET PEDIEN=""

 +14               FOR 

                       SET PEDIEN=$ORDER(^AUPNVPED("AA",DFN,RPEDDT,PEDIEN))

                       IF PEDIEN=""

                           QUIT 

                       Begin DoDot:2

 +15                       SET DA=PEDIEN

 +16                       SET PEDDT=9999999-RPEDDT

 +17                       SET IENS=$$IENS^DILF(.DA)

 +18                       SET TEXT=""

 +19                       SET TEXT=$$SETFLD^VALM1($SELECT(PEDDT'=PPEDDT:$$FMTE^XLFDT(PEDDT,"5Z"),1:""),TEXT,"Visit")

 +20                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".01","E"),TEXT,"Class")

 +21                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".06","E"),TEXT,"Level")

 +22                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".05","E"),TEXT,"Provider")

 +23                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".14","E"),TEXT,"Objs Met")

 +24                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".07","E"),TEXT,"I/G")

 +25                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".08","E"),TEXT,"Len")

 +26                       SET TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.16,IENS,".13","I"),TEXT,"Beh")

 +27                       SET VALMCNT=$GET(VALMCNT)+1

                           DO SET^VALM10(VALMCNT,TEXT)

 +28                       SET PPEDDT=PEDDT

                       End DoDot:2

               End DoDot:1

 +29       DO ^XBFMK

 +30       QUIT 

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !

 +2        QUIT 

 +3       ;

EXIT      ;

 +1        KILL ^TMP("BKMVA61",$JOB)

 +2        KILL VALM0,VALMAR,VALMHDR,VALMCNT

 +3        QUIT 

 +4       ;

 +5       ;