AGRHI1 ; IHS/ASDS/EFG - RESTRICTED HEALTH REPORT ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;THIS ROUTINE WILL CREATE A REPORT BASED ON THE RESTIRCTED
;HEALTH INFORMATION FILE
;
Q
EN ;EP
K AG("F1")
D BEGDT
Q:$D(DTOUT)!$D(DUOUT)
S AGQ("RC")="PROCESS^AGRHI1"
S AGQ("RP")="PRINT^AGRHI1"
S AGQ("RX")="EXIT^AGRHI1"
S AGQ("NS")="AG"
D ^AGDBQUE
Q
BEGDT ;PROMPT FOR BEGINNING DATE OF ENTRY
S AG("PAGE")=0
K DIR,X,Y
S DIR(0)="D"
S DIR("A")="Please enter a beginning Date Of Entry. "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)
S X=Y S BDT=+Y D DD^%DT S AG("BEGDT")=Y
ENDDT ;PROMPT FOR ENDING DATE OF ENTRY
K DIR,X,Y
S DIR(0)="D"
S DIR("A")="Please enter an ending Date Of Entry. "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)
S X=Y S EDT=+Y D DD^%DT S AG("ENDDT")=Y
Q
HDR ;PRINT THE PAGE HEADER
W @IOF
S AG("PAGE")=AG("PAGE")+1
W !,?19,"*** RESTRICTED HEALTH INFORMATION REPORT ***"
W ?70,"Page ",AG("PAGE")
S AG("RHIDT")=$$NOW^XLFDT
S AG("DSPDAT")=$E(AG("RHIDT"),4,5)_"/"_$E(AG("RHIDT"),6,7)_"/"_($E(AG("RHIDT"),1,3)+1700)_" "_$E(AG("RHIDT"),9,10)_":"_$E(AG("RHIDT"),11,12)
S AG("DSPDAT")="RUN DATE/TIME : "_AG("DSPDAT")
W !,?(80-$L(AG("DSPDAT"))/2),AG("DSPDAT")
W !!,"BEGINNING ENTRY DATE: ",AG("BEGDT")
W !,"ENDING ENTRY DATE: ",AG("ENDDT")
W !!,"PERSON",?18,"DATE OF"
W !,"ENTERING",?19,"ENTRY",?30,"MR#",?38,"STATUS",?46,"REQUEST INFO"
W !,"--------",?18,"-----",?30,"---",?38,"------",?46,"------------",!
Q
PROCESS ;PROCESS LOOP FOR REPORT RECORDS
;DO SCREENING LOGIC - BUILD XTMP GLOBAL
S ENTDAT=0
F S ENTDAT=$O(^AUPNRHI("G",ENTDAT)) Q:'+ENTDAT D
. Q:$P(ENTDAT,".",1)<BDT!($P(ENTDAT,".",1)>EDT)
. S RHISTAT=""
. F S RHISTAT=$O(^AUPNRHI("G",ENTDAT,RHISTAT)) Q:RHISTAT="" D
.. S RHIREC=0
.. F S RHIREC=$O(^AUPNRHI("G",ENTDAT,RHISTAT,RHIREC)) Q:'+RHIREC D
... S RECORD=$G(^AUPNRHI(RHIREC,0))
... S DFN=$P(RECORD,U)
... S MR=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
... S RHI=$P(RECORD,U,2)
... S STREC=$S(RHISTAT="A":2,RHISTAT="P":1,RHISTAT="N":3,RHISTAT="R":4,RHISTAT="E":5)
... S USER=$S(STREC=1:$P($G(^AUPNRHI(RHIREC,STREC)),U,2),STREC=5:$P($G(^AUPNRHI(RHIREC,STREC)),U),1:$P($G(^AUPNRHI(RHIREC,STREC)),U,3))
... S ^XTMP("AGRHI",$J,ENTDAT,USER)=MR_U_RHISTAT_U_RHI
K ENTDAT,RHIREC,RECORD,DFN,MR,RHISTAT,RHI,USER,STREC,BDT,EDT
Q
PRINT ;DO HEADER AND DETAIL PRINTING HERE
D HDR
S (ENTDAT,USER,CNT)=0,RHIREC=""
F S ENTDAT=$O(^XTMP("AGRHI",$J,ENTDAT)) Q:'ENTDAT D Q:$G(AG("F1"))
. F S USER=$O(^XTMP("AGRHI",$J,ENTDAT,USER)) Q:'USER D Q:$G(AG("F1"))
.. S RHIREC=$G(^XTMP("AGRHI",$J,ENTDAT,USER))
.. S USERNAM=$P($G(^VA(200,USER,0)),U)
.. S EDATE=$E(ENTDAT,4,5)_"/"_$E(ENTDAT,6,7)_"/"_($E(ENTDAT,1,3)+1700)
.. S MR=$P(RHIREC,U)
.. S STATUS=$P(RHIREC,U,2)
.. S RHI=$P(RHIREC,U,3)
.. I $Y>(IOSL-5) D HD Q:$G(AG("F1"))
.. W !,USERNAM,?18,EDATE,?30,$$RJ^XLFSTR(MR,6),?40,STATUS
.. S CNT=CNT+1
.. S AG("Y")=$L(RHI)
.. F S AG("K")=$E(RHI,1,34) Q:$L(AG("K"))=0 S RHI=$E(RHI,35,AG("Y")) W ?46,AG("K"),!
W !!,CNT," Records found from ",AG("BEGDT")," TO ",AG("ENDDT")
Q
HD ;
I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) D
. F W ! Q:$Y+3>IOSL
. K DIR S DIR(0)="E" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S AG("F1")=1
D HDR
Q
EXIT ;
K ^XTMP("AGRHI",$J)
Q
AGRHI1 ; IHS/ASDS/EFG - RESTRICTED HEALTH REPORT ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;THIS ROUTINE WILL CREATE A REPORT BASED ON THE RESTIRCTED
+4 ;HEALTH INFORMATION FILE
+5 ;
+6 QUIT
EN ;EP
+1 KILL AG("F1")
+2 DO BEGDT
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 SET AGQ("RC")="PROCESS^AGRHI1"
+5 SET AGQ("RP")="PRINT^AGRHI1"
+6 SET AGQ("RX")="EXIT^AGRHI1"
+7 SET AGQ("NS")="AG"
+8 DO ^AGDBQUE
+9 QUIT
BEGDT ;PROMPT FOR BEGINNING DATE OF ENTRY
+1 SET AG("PAGE")=0
+2 KILL DIR,X,Y
+3 SET DIR(0)="D"
+4 SET DIR("A")="Please enter a beginning Date Of Entry. "
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET X=Y
SET BDT=+Y
DO DD^%DT
SET AG("BEGDT")=Y
ENDDT ;PROMPT FOR ENDING DATE OF ENTRY
+1 KILL DIR,X,Y
+2 SET DIR(0)="D"
+3 SET DIR("A")="Please enter an ending Date Of Entry. "
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 SET X=Y
SET EDT=+Y
DO DD^%DT
SET AG("ENDDT")=Y
+7 QUIT
HDR ;PRINT THE PAGE HEADER
+1 WRITE @IOF
+2 SET AG("PAGE")=AG("PAGE")+1
+3 WRITE !,?19,"*** RESTRICTED HEALTH INFORMATION REPORT ***"
+4 WRITE ?70,"Page ",AG("PAGE")
+5 SET AG("RHIDT")=$$NOW^XLFDT
+6 SET AG("DSPDAT")=$EXTRACT(AG("RHIDT"),4,5)_"/"_$EXTRACT(AG("RHIDT"),6,7)_"/"_($EXTRACT(AG("RHIDT"),1,3)+1700)_" "_$EXTRACT(AG("RHIDT"),9,10)_":"_$EXTRACT(AG("RHIDT"),11,12)
+7 SET AG("DSPDAT")="RUN DATE/TIME : "_AG("DSPDAT")
+8 WRITE !,?(80-$LENGTH(AG("DSPDAT"))/2),AG("DSPDAT")
+9 WRITE !!,"BEGINNING ENTRY DATE: ",AG("BEGDT")
+10 WRITE !,"ENDING ENTRY DATE: ",AG("ENDDT")
+11 WRITE !!,"PERSON",?18,"DATE OF"
+12 WRITE !,"ENTERING",?19,"ENTRY",?30,"MR#",?38,"STATUS",?46,"REQUEST INFO"
+13 WRITE !,"--------",?18,"-----",?30,"---",?38,"------",?46,"------------",!
+14 QUIT
PROCESS ;PROCESS LOOP FOR REPORT RECORDS
+1 ;DO SCREENING LOGIC - BUILD XTMP GLOBAL
+2 SET ENTDAT=0
+3 FOR
SET ENTDAT=$ORDER(^AUPNRHI("G",ENTDAT))
IF '+ENTDAT
QUIT
Begin DoDot:1
+4 IF $PIECE(ENTDAT,".",1)<BDT!($PIECE(ENTDAT,".",1)>EDT)
QUIT
+5 SET RHISTAT=""
+6 FOR
SET RHISTAT=$ORDER(^AUPNRHI("G",ENTDAT,RHISTAT))
IF RHISTAT=""
QUIT
Begin DoDot:2
+7 SET RHIREC=0
+8 FOR
SET RHIREC=$ORDER(^AUPNRHI("G",ENTDAT,RHISTAT,RHIREC))
IF '+RHIREC
QUIT
Begin DoDot:3
+9 SET RECORD=$GET(^AUPNRHI(RHIREC,0))
+10 SET DFN=$PIECE(RECORD,U)
+11 SET MR=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+12 SET RHI=$PIECE(RECORD,U,2)
+13 SET STREC=$SELECT(RHISTAT="A":2,RHISTAT="P":1,RHISTAT="N":3,RHISTAT="R":4,RHISTAT="E":5)
+14 SET USER=$SELECT(STREC=1:$PIECE($GET(^AUPNRHI(RHIREC,STREC)),U,2),STREC=5:$PIECE($GET(^AUPNRHI(RHIREC,STREC)),U),1:$PIECE($GET(^AUPNRHI(RHIREC,STREC)),U,3))
+15 SET ^XTMP("AGRHI",$JOB,ENTDAT,USER)=MR_U_RHISTAT_U_RHI
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL ENTDAT,RHIREC,RECORD,DFN,MR,RHISTAT,RHI,USER,STREC,BDT,EDT
+17 QUIT
PRINT ;DO HEADER AND DETAIL PRINTING HERE
+1 DO HDR
+2 SET (ENTDAT,USER,CNT)=0
SET RHIREC=""
+3 FOR
SET ENTDAT=$ORDER(^XTMP("AGRHI",$JOB,ENTDAT))
IF 'ENTDAT
QUIT
Begin DoDot:1
+4 FOR
SET USER=$ORDER(^XTMP("AGRHI",$JOB,ENTDAT,USER))
IF 'USER
QUIT
Begin DoDot:2
+5 SET RHIREC=$GET(^XTMP("AGRHI",$JOB,ENTDAT,USER))
+6 SET USERNAM=$PIECE($GET(^VA(200,USER,0)),U)
+7 SET EDATE=$EXTRACT(ENTDAT,4,5)_"/"_$EXTRACT(ENTDAT,6,7)_"/"_($EXTRACT(ENTDAT,1,3)+1700)
+8 SET MR=$PIECE(RHIREC,U)
+9 SET STATUS=$PIECE(RHIREC,U,2)
+10 SET RHI=$PIECE(RHIREC,U,3)
+11 IF $Y>(IOSL-5)
DO HD
IF $GET(AG("F1"))
QUIT
+12 WRITE !,USERNAM,?18,EDATE,?30,$$RJ^XLFSTR(MR,6),?40,STATUS
+13 SET CNT=CNT+1
+14 SET AG("Y")=$LENGTH(RHI)
+15 FOR
SET AG("K")=$EXTRACT(RHI,1,34)
IF $LENGTH(AG("K"))=0
QUIT
SET RHI=$EXTRACT(RHI,35,AG("Y"))
WRITE ?46,AG("K"),!
End DoDot:2
IF $GET(AG("F1"))
QUIT
End DoDot:1
IF $GET(AG("F1"))
QUIT
+16 WRITE !!,CNT," Records found from ",AG("BEGDT")," TO ",AG("ENDDT")
+17 QUIT
HD ;
+1 IF '$DATA(IO("Q"))
IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
Begin DoDot:1
+2 FOR
WRITE !
IF $Y+3>IOSL
QUIT
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET AG("F1")=1
+5 DO HDR
+6 QUIT
EXIT ;
+1 KILL ^XTMP("AGRHI",$JOB)
+2 QUIT
