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
Q
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")
Q
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
Q
;
AR Q
;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
Q
N QUIT
W !!?16,"*** END CONFIDENTIAL PATIENT INFORMATION ***",!
I IOST["C-" S QUIT=$$PAUSE^BKMIXX3()
Q
XIT ;EXIT ROUTINE
Q
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
+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
+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
