Routine: BKMVSRP1

BKMVSRP1 ;PRXM/HC/CJS - Continuation of BKMVSRP BKMV, State Reporting Report; [ 1/19/2005  7:16 PM ] ; 17 Jul 2005  1:09 PM

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

 ;PRXM/HC/CJS 07/07/2005 -- In addition to the explicit changes described below,

 ;variables have been NEWed or KILLed as needed to prevent strays.

 ;07/14/2005 -- Added Patient Name function for new sort criterion

 ;07/17/2005 -- Fixed use of correct piece of BKMIEN throughout

PATNAME(BKMIEN) ;return patient name

 N PATNAME

 S PATNAME=$$GET1^DIQ(9000001,$P(BKMIEN,U,2)_",",.01)

 Q PATNAME

HRECNO(BKMIEN) ;return patient's HREC Number

 Q $$HRN^BKMVA1($P(BKMIEN,U,2))

GET(BKMIEN) ;EP - BKMIEN=HMS Registry IEN^Patient IEN, i.e., a result returned from a FileMan ^DIC lookup

 ;iCARE REGISTRY FILE

 N DA,DIC,DIQ,DR,REGISTER,REGIEN,SRSIENS,X,Y

 S REGISTER=$$HIVIEN^BKMIXX3()

 S DA=+BKMIEN

 S REGIEN=$O(^BKM(90451,DA,1,"B",REGISTER,""))

 ; VA PATIENT FILE from HMS REGISTRY

 S DIC="^BKM(90451,",DR=".02",DIQ="LOCAL",DIQ(0)="IE" D EN^DIQ1

 ; DIAGNOSIS, STATE REPORTING STATUS and STATE REPORTING DATE from iCARE REGISTRY FILE <--

 ; STATE CONFIRMATION STATUS and STATE CONFIRMATION DATE from iCARE REGISTRY FILE <--

 D GETS^DIQ(90451.01,REGIEN_","_BKMIEN_",","2.3;.5;5;5.5;4;4.1;4.2;4.3;4.5;4.51;4.52;4.53","IE","LOCAL")

 ; get PATIENT NAME,SEX,DOB from VA PATIENT FILE

 S DA=DFN

 S DIC="^DPT(",DR=".01",DIQ="LOCAL" D EN^DIQ1

 S DIC="^DPT(",DR=".02;.03",DIQ="LOCAL",DIQ(0)="I" D EN^DIQ1

 ;get HEALTH RECORD NUMBER from PATIENT FILE

 S LOCAL("HRECNO")=$$HRN^BKMVA1(DFN)

 ; AGE and Community

 S DIC="^AUPNPAT(",DA=DFN,DR="1102.98;1118",DIQ="LOCAL",DIQ(0)="" D EN^DIQ1

 D GETS^DIQ(90451.01,REGIEN_","_BKMIEN_",",".015","IE","LOCAL")

PRINT(PAGE,LINES,BKMIEN) ;EP - Print Report

 N BKMSTAT,SRSIENS,REGCAT,ASR,HSR

 I '$D(PAGE) S PAGE=1

 I '$D(LINES) S LINES=0

 S BKMSTAT=$P($G(^BKM(90451,BKMIEN,1,1,0)),U,7)

 N A,BKMRDIAG,DPTIEN,DTOUT,AGE

 ; dashed lines

 S $P(A,"-",79)=""

 S DPTIEN=DFN

 ; Array LOCAL must be set up with the following subscripts

 ;LOCAL(2,DPTIEN,.01)=name

 ;LOCAL(2,DPTIEN,.01,"E")=name

 ;LOCAL(2,DPTIEN,.02,"I")=sex...not a Yes/No

 ;LOCAL(2,DPTIEN,.03,"I")=date of birth in internal format

 ;LOCAL(9000001,BKMIEN,1102.98)=age

 ;LOCAL(9000001,BKMIEN,1118)=community

 ;LOCAL(90451.01,"1,"_BKMIEN_",",.015,"E")=FACILITY(WHERE FOLLOWS)

 ;LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"E")=DIAGNOSIS CATEGORY

 ;LOCAL(90451.01,"1,"_BKMIEN_",",5,"I")=INITIAL HIV DX DATE

 ;LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I")=INITIAL AIDS DX DATE

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.3,"I")=STATE HIV REPORT STATUS

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4,"I")=STATE HIV REPORT DATE

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.1,"E")=STATE HIV CONFIRMATION STATUS

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.2,"E")=STATE HIV CONFIRMATION DATE

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.51,"E")=STATE AIDS ACKNOWLEDGEMENT STATUS

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"E")=STATE AIDS ACKNOWLEDGEMENT DATE

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"I")=STATE AIDS REPORT STATUS

 ;LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I")=STATE AIDS REPORT DATE

 ;LOCAL("HRECNO")=HEALTH RECORD NUMBER

 I PAGE=1!(LINES=0) D HEADER

 W ?1,$E($G(LOCAL(2,DPTIEN,.01,"E")),1,20),?23,$E($G(LOCAL("HRECNO")),1,9)

 ;The following 3 ";" lines will change age look-up since 1102.98 does not take date of death into account

 ;S AGE=$$UP^XLFSTR($$AGE^BKMIMRP1(DPTIEN))

 ;W ?30,$E($G(LOCAL(9000001,DPTIEN,1118)),1,12),?43,AGE I AGE?1.N W "Y"

 ;W ?48,$G(LOCAL(2,DPTIEN,.02,"I"))

 W ?30,$E($G(LOCAL(9000001,DPTIEN,1118)),1,12),?43,$E($P($G(LOCAL(9000001,DPTIEN,1102.98))," "),1,3)

 W $E($P($G(LOCAL(9000001,DPTIEN,1102.98))," ",2),1),?48,$G(LOCAL(2,DPTIEN,.02,"I"))

 W ?51,$G(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"E"))

 I $G(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"I"))="H",$G(LOCAL(90451.01,"1,"_BKMIEN_",",5,"I")) D

 . W ?57,$P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",5,"I"),"2Z"),"@")

 I $G(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"I"))="A",$G(LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I")) D

 . W ?57,$P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I"),"2Z"),"@")

 W ?67,$E(LOCAL(90451.01,"1,"_BKMIEN_",",.015,"E"),1,12)

 I STHIV'=0 D

 . W !?5,"HIV Report:  "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",","4.3","I"))="" W "Not documented" Q

 . W ?8,$G(LOCAL(90451.01,"1,"_BKMIEN_",","4.3","E"))," "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",",4,"I")) D

 . . W $P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4,"I"),"2Z"),"@")

 . W ?43,"Receipt Confirmed: "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",","4.1","I"))="" W "Not documented" Q

 . W $G(LOCAL(90451.01,"1,"_BKMIEN_",","4.1","E"))," "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",","4.2","I")) D

 . . W $P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",","4.2","I"),"2Z"),"@")

 I STHIV'=0 D

 . W !?5,"AIDS Report: "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"I"))="" W "Not documented" Q

 . W ?8,$G(LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"E"))," "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I")) D

 . . W $P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I"),"2Z"),"@")

 . W ?43,"Receipt Confirmed: "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",","4.51","I"))="" W "Not documented" Q

 . W $G(LOCAL(90451.01,"1,"_BKMIEN_",",4.51,"E"))," "

 . I $G(LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"I")) D

 . . W $P($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"I"),"2Z"),"@")

 W !!

 S LINES=LINES+3

 G:$Y<(IOSL-5) AR

 S QUIT=$$PAUSE^BKMIXX3() I QUIT S QUITALL=1 Q

 S LINES=0

AR Q

HEADER ;

 ;PRINT HEADER

 N BKMLOC,X,NAME

 I $G(NOW)="" S NOW=$$FMTE^XLFDT(DT)

 W:PAGE>1 @IOF

 S BKMLOC=$P(^AUTTSITE(1,0),U,1),BKMLOC=$P(^DIC(4,BKMLOC,0),U,1)

 W !?1,$P(^VA(200,DUZ,0),U,2)

 W ?IOM-$L(NOW)\2,NOW,?IOM-10,"Page: ",PAGE

 W !?IOM-$L(BKMLOC)\2,BKMLOC

 W !?IOM-41\2,"*** HMS State Reporting Status Report ***"

 S NAME="HMS Active Patients: ["_$S(CAT="A":"All",CAT="N":"Not Reported",1:"Reported")_"]"

 W !?IOM-$L(NAME)\2,NAME

 W !?18,"***  CONFIDENTIAL PATIENT INFORMATION  ***"

 W !?68,"Where"

 W !?1,"Patient Name",?24,"HRN",?30,"Community",?43,"Age",?47,"Sex",?52,"DX"

 W ?60,"Date",?67,"Followed"

 W !?1,A,!

 S LINES=10,PAGE=PAGE+1

FOOTER ;EP - Confidentiality notice

 N QUIT

 W !!?16,"*** END CONFIDENTIAL PATIENT INFORMATION ***",!

 I IOST["C-" S QUIT=$$PAUSE^BKMIXX3()

XIT ;EXIT ROUTINE

BKMVSRP1  ;PRXM/HC/CJS - Continuation of BKMVSRP BKMV, State Reporting Report; [ 1/19/2005  7:16 PM ] ; 17 Jul 2005  1:09 PM

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

 +2       ;PRXM/HC/CJS 07/07/2005 -- In addition to the explicit changes described below,

 +3       ;variables have been NEWed or KILLed as needed to prevent strays.

 +4       ;07/14/2005 -- Added Patient Name function for new sort criterion

 +5       ;07/17/2005 -- Fixed use of correct piece of BKMIEN throughout

 +6        QUIT

PATNAME(BKMIEN) ;return patient name

 +1        NEW PATNAME

 +2        SET PATNAME=$$GET1^DIQ(9000001,$PIECE(BKMIEN,U,2)_",",.01)

 +3        QUIT PATNAME

HRECNO(BKMIEN) ;return patient's HREC Number

 +1        QUIT $$HRN^BKMVA1($PIECE(BKMIEN,U,2))

GET(BKMIEN) ;EP - BKMIEN=HMS Registry IEN^Patient IEN, i.e., a result returned from a FileMan ^DIC lookup

 +1       ;iCARE REGISTRY FILE

 +2        NEW DA,DIC,DIQ,DR,REGISTER,REGIEN,SRSIENS,X,Y

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

 +4        SET DA=+BKMIEN

 +5        SET REGIEN=$ORDER(^BKM(90451,DA,1,"B",REGISTER,""))

 +6       ; VA PATIENT FILE from HMS REGISTRY

 +7        SET DIC="^BKM(90451,"

           SET DR=".02"

           SET DIQ="LOCAL"

           SET DIQ(0)="IE"

           DO EN^DIQ1

 +8       ; DIAGNOSIS, STATE REPORTING STATUS and STATE REPORTING DATE from iCARE REGISTRY FILE <--

 +9       ; STATE CONFIRMATION STATUS and STATE CONFIRMATION DATE from iCARE REGISTRY FILE <--

 +10       DO GETS^DIQ(90451.01,REGIEN_","_BKMIEN_",","2.3;.5;5;5.5;4;4.1;4.2;4.3;4.5;4.51;4.52;4.53","IE","LOCAL")

 +11      ; get PATIENT NAME,SEX,DOB from VA PATIENT FILE

 +12       SET DA=DFN

 +13       SET DIC="^DPT("

           SET DR=".01"

           SET DIQ="LOCAL"

           DO EN^DIQ1

 +14       SET DIC="^DPT("

           SET DR=".02;.03"

           SET DIQ="LOCAL"

           SET DIQ(0)="I"

           DO EN^DIQ1

 +15      ;get HEALTH RECORD NUMBER from PATIENT FILE

 +16       SET LOCAL("HRECNO")=$$HRN^BKMVA1(DFN)

 +17      ; AGE and Community

 +18       SET DIC="^AUPNPAT("

           SET DA=DFN

           SET DR="1102.98;1118"

           SET DIQ="LOCAL"

           SET DIQ(0)=""

           DO EN^DIQ1

 +19       DO GETS^DIQ(90451.01,REGIEN_","_BKMIEN_",",".015","IE","LOCAL")

 +20       QUIT

PRINT(PAGE,LINES,BKMIEN) ;EP - Print Report

 +1        NEW BKMSTAT,SRSIENS,REGCAT,ASR,HSR

 +2        IF '$DATA(PAGE)

               SET PAGE=1

 +3        IF '$DATA(LINES)

               SET LINES=0

 +4        SET BKMSTAT=$PIECE($GET(^BKM(90451,BKMIEN,1,1,0)),U,7)

 +5        NEW A,BKMRDIAG,DPTIEN,DTOUT,AGE

 +6       ; dashed lines

 +7        SET $PIECE(A,"-",79)=""

 +8        SET DPTIEN=DFN

 +9       ;

 +10      ; Array LOCAL must be set up with the following subscripts

 +11      ;LOCAL(2,DPTIEN,.01)=name

 +12      ;LOCAL(2,DPTIEN,.01,"E")=name

 +13      ;LOCAL(2,DPTIEN,.02,"I")=sex...not a Yes/No

 +14      ;LOCAL(2,DPTIEN,.03,"I")=date of birth in internal format

 +15      ;LOCAL(9000001,BKMIEN,1102.98)=age

 +16      ;LOCAL(9000001,BKMIEN,1118)=community

 +17      ;LOCAL(90451.01,"1,"_BKMIEN_",",.015,"E")=FACILITY(WHERE FOLLOWS)

 +18      ;LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"E")=DIAGNOSIS CATEGORY

 +19      ;LOCAL(90451.01,"1,"_BKMIEN_",",5,"I")=INITIAL HIV DX DATE

 +20      ;LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I")=INITIAL AIDS DX DATE

 +21      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.3,"I")=STATE HIV REPORT STATUS

 +22      ;LOCAL(90451.01,"1,"_BKMIEN_",",4,"I")=STATE HIV REPORT DATE

 +23      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.1,"E")=STATE HIV CONFIRMATION STATUS

 +24      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.2,"E")=STATE HIV CONFIRMATION DATE

 +25      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.51,"E")=STATE AIDS ACKNOWLEDGEMENT STATUS

 +26      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"E")=STATE AIDS ACKNOWLEDGEMENT DATE

 +27      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"I")=STATE AIDS REPORT STATUS

 +28      ;LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I")=STATE AIDS REPORT DATE

 +29      ;LOCAL("HRECNO")=HEALTH RECORD NUMBER

 +30      ;

 +31       IF PAGE=1!(LINES=0)

               DO HEADER

 +32       WRITE ?1,$EXTRACT($GET(LOCAL(2,DPTIEN,.01,"E")),1,20),?23,$EXTRACT($GET(LOCAL("HRECNO")),1,9)

 +33      ;The following 3 ";" lines will change age look-up since 1102.98 does not take date of death into account

 +34      ;S AGE=$$UP^XLFSTR($$AGE^BKMIMRP1(DPTIEN))

 +35      ;W ?30,$E($G(LOCAL(9000001,DPTIEN,1118)),1,12),?43,AGE I AGE?1.N W "Y"

 +36      ;W ?48,$G(LOCAL(2,DPTIEN,.02,"I"))

 +37       WRITE ?30,$EXTRACT($GET(LOCAL(9000001,DPTIEN,1118)),1,12),?43,$EXTRACT($PIECE($GET(LOCAL(9000001,DPTIEN,1102.98))," "),1,3)

 +38       WRITE $EXTRACT($PIECE($GET(LOCAL(9000001,DPTIEN,1102.98))," ",2),1),?48,$GET(LOCAL(2,DPTIEN,.02,"I"))

 +39       WRITE ?51,$GET(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"E"))

 +40       IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"I"))="H"

               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",5,"I"))

                   Begin DoDot:1

 +41                   WRITE ?57,$PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",5,"I"),"2Z"),"@")

                   End DoDot:1

 +42       IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"I"))="A"

               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I"))

                   Begin DoDot:1

 +43                   WRITE ?57,$PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",5.5,"I"),"2Z"),"@")

                   End DoDot:1

 +44       WRITE ?67,$EXTRACT(LOCAL(90451.01,"1,"_BKMIEN_",",.015,"E"),1,12)

 +45       IF STHIV'=0

               Begin DoDot:1

 +46               WRITE !?5,"HIV Report:  "

 +47               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.3","I"))=""

                       WRITE "Not documented"

                       QUIT

 +48               WRITE ?8,$GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.3","E"))," "

 +49               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",4,"I"))

                       Begin DoDot:2

 +50                       WRITE $PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4,"I"),"2Z"),"@")

                       End DoDot:2

 +51               WRITE ?43,"Receipt Confirmed: "

 +52               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.1","I"))=""

                       WRITE "Not documented"

                       QUIT

 +53               WRITE $GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.1","E"))," "

 +54               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.2","I"))

                       Begin DoDot:2

 +55                       WRITE $PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",","4.2","I"),"2Z"),"@")

                       End DoDot:2

               End DoDot:1

 +56       IF STHIV'=0

               Begin DoDot:1

 +57               WRITE !?5,"AIDS Report: "

 +58               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"I"))=""

                       WRITE "Not documented"

                       QUIT

 +59               WRITE ?8,$GET(LOCAL(90451.01,"1,"_BKMIEN_",",4.53,"E"))," "

 +60               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I"))

                       Begin DoDot:2

 +61                       WRITE $PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4.5,"I"),"2Z"),"@")

                       End DoDot:2

 +62               WRITE ?43,"Receipt Confirmed: "

 +63               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",","4.51","I"))=""

                       WRITE "Not documented"

                       QUIT

 +64               WRITE $GET(LOCAL(90451.01,"1,"_BKMIEN_",",4.51,"E"))," "

 +65               IF $GET(LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"I"))

                       Begin DoDot:2

 +66                       WRITE $PIECE($$FMTE^XLFDT(LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"I"),"2Z"),"@")

                       End DoDot:2

               End DoDot:1

 +67       WRITE !!

 +68       SET LINES=LINES+3

 +69       IF $Y<(IOSL-5)

               GOTO AR

 +70       SET QUIT=$$PAUSE^BKMIXX3()

           IF QUIT

               SET QUITALL=1

               QUIT

 +71       SET LINES=0

 +72       QUIT

 +73      ;

AR         QUIT

HEADER    ;

 +1       ;PRINT HEADER

 +2        NEW BKMLOC,X,NAME

 +3        IF $GET(NOW)=""

               SET NOW=$$FMTE^XLFDT(DT)

 +4        IF PAGE>1

               WRITE @IOF

 +5        SET BKMLOC=$PIECE(^AUTTSITE(1,0),U,1)

           SET BKMLOC=$PIECE(^DIC(4,BKMLOC,0),U,1)

 +6        WRITE !?1,$PIECE(^VA(200,DUZ,0),U,2)

 +7        WRITE ?IOM-$LENGTH(NOW)\2,NOW,?IOM-10,"Page: ",PAGE

 +8        WRITE !?IOM-$LENGTH(BKMLOC)\2,BKMLOC

 +9        WRITE !?IOM-41\2,"*** HMS State Reporting Status Report ***"

 +10       SET NAME="HMS Active Patients: ["_$SELECT(CAT="A":"All",CAT="N":"Not Reported",1:"Reported")_"]"

 +11       WRITE !?IOM-$LENGTH(NAME)\2,NAME

 +12       WRITE !?18,"***  CONFIDENTIAL PATIENT INFORMATION  ***"

 +13       WRITE !?68,"Where"

 +14       WRITE !?1,"Patient Name",?24,"HRN",?30,"Community",?43,"Age",?47,"Sex",?52,"DX"

 +15       WRITE ?60,"Date",?67,"Followed"

 +16       WRITE !?1,A,!

 +17       SET LINES=10

           SET PAGE=PAGE+1

 +18       QUIT

FOOTER    ;EP - Confidentiality notice

 +1        NEW QUIT

 +2        WRITE !!?16,"*** END CONFIDENTIAL PATIENT INFORMATION ***",!

 +3        IF IOST["C-"

               SET QUIT=$$PAUSE^BKMIXX3()

 +4        QUIT

XIT       ;EXIT ROUTINE

 +1        QUIT

BKMVSRP1.m