- AGGRPRT1 ; VNGT/HS/KDC - ;
- ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
- ;
- ; Copied from AGREPRT1
- ;
- S AGBDT=AG("B")-.1,AG("FAC")=AGGDUZ2
- D ^AGPATCNT
- K DUOUT,DTOUT,DFOUT
- D NOW^AG S X="as of : "_AGTIME D CTR^AG S AGTIME=X U IO G ^AGREPRT2:AG("TYPE")>2
- X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",") D CTR^AG S AGUCI=X,X=$P(^DIC(4,AGGDUZ2,0),U) D CTR^AG S AG("LOC")=X,AG("USR")=$P(^VA(200,DUZ,0),U),AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4
- S AGBDTS=AGBDT
- D SCAN
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- D PRINT
- G END
- SCAN ;scan dates
- S AGPGPG=0,(AG("NEW"),AG("KILL"),AG("EDIT"))=0
- K ^TMP($J)
- F S AGBDTS=$O(^AGPATCH(AGBDTS)),AGBDT=AGBDTS\1 Q:(AGBDT=0!(AGBDT>AG("E"))) Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D LPAT
- Q
- LPAT ;loop patients
- Q:'$D(^AGPATCH(AGBDTS,AGGDUZ2))
- S AG("DFN")=0 F S AG("DFN")=$O(^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN"))) Q:AG("DFN")="" Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D PAT
- Q
- PAT ;individual patient
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- S AG("GL")=^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN")) I $P(AG("GL"),U,2)]""&($P(AG("GL"),U,3)="") S ^TMP($J,AGBDT,"K")=1+$G(^TMP($J,AGBDT,"K")) Q
- Q:'$D(^AUPNPAT(AG("DFN"),0))!'$D(^AUPNPAT(AG("DFN"),41,AGGDUZ2,0))
- I AG("GL")="NEW" S ^TMP($J,AGBDT,"N")=1+$G(^TMP($J,AGBDT,"N")),^TMP($J,AGBDT,"N",AG("DFN"))="" Q
- S:'$D(^TMP($J,AGBDT,"E",AG("DFN"))) ^TMP($J,AGBDT,"E",AG("DFN"))="",^TMP($J,AGBDT,"E")=1+$G(^TMP($J,AGBDT,"E"))
- Q
- PRINT ;
- S (AG("EDIT"),AG("KILL"),AG("NEW"))=0
- S AGBDT="" F S AGBDT=$O(^TMP($J,AGBDT)) Q:'AGBDT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D
- .S AG("EDIT")=AG("EDIT")+$G(^TMP($J,AGBDT,"E"))
- .S AG("NEW")=AG("NEW")+$G(^TMP($J,AGBDT,"N"))
- .S AG("KILL")=AG("KILL")+$G(^TMP($J,AGBDT,"K"))
- S AG("HD")="Statistics totals" D HDR
- U IO W !,"Total patients Added :",?30,AG("NEW")
- W !,"Total patients Edited :",?30,AG("EDIT")
- W !,"Total patients Removed :",?30,AG("KILL")
- W !,"Total patients Registered :",?30,AG("TOTPAT")
- ;D RTRN^AG
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- Q:AG("TYPE")=1
- S AGBDT="" F S AGBDT=$O(^TMP($J,AGBDT)) Q:'AGBDT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D DAY
- Q
- DAY ;print a days information
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- S ^TMP($J,AGBDT,"N")=$G(^TMP($J,AGBDT,"N"))
- S ^TMP($J,AGBDT,"E")=$G(^TMP($J,AGBDT,"E"))
- S ^TMP($J,AGBDT,"K")=$G(^TMP($J,AGBDT,"K"))
- D HDR
- W !!,?4,"NEW PATIENTS REGISTERED: ",^TMP($J,AGBDT,"N"),!!,?7,"PATIENT FILES EDITED: ",^TMP($J,AGBDT,"E"),!! I ^TMP($J,AGBDT,"K")>0 W ?6,"PATIENT FILES DELETED: ",^TMP($J,AGBDT,"K"),!!
- W ?2,"TOTAL PATIENTS REGISTERED: ",AG("TOTPAT"),!!
- ;D RTRN^AG
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- D NEW,EDIT
- Q
- NEW I ^TMP($J,AGBDT,"N")'>0 Q
- S AG("HD")="THE FOLLOWING PATIENTS WERE ADDED:" D HDR,UCI1
- F DFN=0:0 S DFN=$O(^TMP($J,AGBDT,"N",DFN)) Q:'DFN D FILE Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- ;D RTRN^AG
- Q
- EDIT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- Q:^TMP($J,AGBDT,"E")'>0
- S AG("HD")="THE FOLLOWING PATIENT FILES WERE EDITED:" D HDR,UCI1
- S DFN=0 F S DFN=$O(^TMP($J,AGBDT,"E",DFN)) Q:'DFN D FILE Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- ;D RTRN^AG
- Q
- END K AG("HAT") ;D RTRN^AG
- ;W $$S^AGVDF("IOF") *** commited out to prevent control characters
- END1 D ^%ZISC
- K ^UTILITY("DIQ1",$J),^TMP($J),A,AG,AGBDT,AGIO,AGTIME,AGBM,DA,DIC,DR,AG("LOC"),AGPGPG,AGUCI,AG("USR"),X,Y
- Q
- FILE W ?5,$P(^DPT(DFN,0),U),?43,$J($P(^AUPNPAT(DFN,41,AGGDUZ2,0),U,2),6)
- ;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 I $D(^(DR)) W ?52,^(DR)
- W ?52,$$GET1^DIQ(9000001,DFN_",",1107.3) ;IHS/SD/TPF AG*7.1*4
- ;S DR=.03 D EN^DIQ1 I $D(^(DR)) W ?66,$J(^(DR),10)
- W ?66,$J($P($$GET1^DIQ(2,DFN_",",.03),"@"),10) ;IHS/SD/TPF AG*7.1*4
- W ! ;I $Y>AGBM D RTRN^AG Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
- Q
- HDR ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(11+$L(Y))\2,"Report for ",Y,!!
- ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
- S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W !!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
- Q
- UCI1 I '$D(AG("TOP")) W ?80-$L(AG("HD"))\2,AG("HD"),!!,?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
- K AG("TOP")
- Q
- AGGRPRT1 ; VNGT/HS/KDC - ;
- +1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
- +2 ;
- +3 ; Copied from AGREPRT1
- +4 ;
- +5 SET AGBDT=AG("B")-.1
- SET AG("FAC")=AGGDUZ2
- +6 DO ^AGPATCNT
- +7 KILL DUOUT,DTOUT,DFOUT
- +8 DO NOW^AG
- SET X="as of : "_AGTIME
- DO CTR^AG
- SET AGTIME=X
- USE IO
- IF AG("TYPE")>2
- GOTO ^AGREPRT2
- +9 XECUTE ^%ZOSF("UCI")
- SET X="UCI: "_$PIECE(Y,",")
- DO CTR^AG
- SET AGUCI=X
- SET X=$PIECE(^DIC(4,AGGDUZ2,0),U)
- DO CTR^AG
- SET AG("LOC")=X
- SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
- SET AGBM=IOSL-10
- IF $DATA(AGIO)
- IF AGIO=IO
- SET AGBM=IOSL-4
- +10 SET AGBDTS=AGBDT
- +11 DO SCAN
- +12 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +13 DO PRINT
- +14 GOTO END
- SCAN ;scan dates
- +1 SET AGPGPG=0
- SET (AG("NEW"),AG("KILL"),AG("EDIT"))=0
- +2 KILL ^TMP($JOB)
- +3 FOR
- SET AGBDTS=$ORDER(^AGPATCH(AGBDTS))
- SET AGBDT=AGBDTS\1
- IF (AGBDT=0!(AGBDT>AG("E")))
- QUIT
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- DO LPAT
- +4 QUIT
- LPAT ;loop patients
- +1 IF '$DATA(^AGPATCH(AGBDTS,AGGDUZ2))
- QUIT
- +2 SET AG("DFN")=0
- FOR
- SET AG("DFN")=$ORDER(^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN")))
- IF AG("DFN")=""
- QUIT
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- DO PAT
- +3 QUIT
- PAT ;individual patient
- +1 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +2 SET AG("GL")=^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN"))
- IF $PIECE(AG("GL"),U,2)]""&($PIECE(AG("GL"),U,3)="")
- SET ^TMP($JOB,AGBDT,"K")=1+$GET(^TMP($JOB,AGBDT,"K"))
- QUIT
- +3 IF '$DATA(^AUPNPAT(AG("DFN"),0))!'$DATA(^AUPNPAT(AG("DFN"),41,AGGDUZ2,0))
- QUIT
- +4 IF AG("GL")="NEW"
- SET ^TMP($JOB,AGBDT,"N")=1+$GET(^TMP($JOB,AGBDT,"N"))
- SET ^TMP($JOB,AGBDT,"N",AG("DFN"))=""
- QUIT
- +5 IF '$DATA(^TMP($JOB,AGBDT,"E",AG("DFN")))
- SET ^TMP($JOB,AGBDT,"E",AG("DFN"))=""
- SET ^TMP($JOB,AGBDT,"E")=1+$GET(^TMP($JOB,AGBDT,"E"))
- +6 QUIT
- PRINT ;
- +1 SET (AG("EDIT"),AG("KILL"),AG("NEW"))=0
- +2 SET AGBDT=""
- FOR
- SET AGBDT=$ORDER(^TMP($JOB,AGBDT))
- IF 'AGBDT
- QUIT
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- Begin DoDot:1
- +3 SET AG("EDIT")=AG("EDIT")+$GET(^TMP($JOB,AGBDT,"E"))
- +4 SET AG("NEW")=AG("NEW")+$GET(^TMP($JOB,AGBDT,"N"))
- +5 SET AG("KILL")=AG("KILL")+$GET(^TMP($JOB,AGBDT,"K"))
- End DoDot:1
- +6 SET AG("HD")="Statistics totals"
- DO HDR
- +7 USE IO
- WRITE !,"Total patients Added :",?30,AG("NEW")
- +8 WRITE !,"Total patients Edited :",?30,AG("EDIT")
- +9 WRITE !,"Total patients Removed :",?30,AG("KILL")
- +10 WRITE !,"Total patients Registered :",?30,AG("TOTPAT")
- +11 ;D RTRN^AG
- +12 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +13 IF AG("TYPE")=1
- QUIT
- +14 SET AGBDT=""
- FOR
- SET AGBDT=$ORDER(^TMP($JOB,AGBDT))
- IF 'AGBDT
- QUIT
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- DO DAY
- +15 QUIT
- DAY ;print a days information
- +1 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +2 SET ^TMP($JOB,AGBDT,"N")=$GET(^TMP($JOB,AGBDT,"N"))
- +3 SET ^TMP($JOB,AGBDT,"E")=$GET(^TMP($JOB,AGBDT,"E"))
- +4 SET ^TMP($JOB,AGBDT,"K")=$GET(^TMP($JOB,AGBDT,"K"))
- +5 DO HDR
- +6 WRITE !!,?4,"NEW PATIENTS REGISTERED: ",^TMP($JOB,AGBDT,"N"),!!,?7,"PATIENT FILES EDITED: ",^TMP($JOB,AGBDT,"E"),!!
- IF ^TMP($JOB,AGBDT,"K")>0
- WRITE ?6,"PATIENT FILES DELETED: ",^TMP($JOB,AGBDT,"K"),!!
- +7 WRITE ?2,"TOTAL PATIENTS REGISTERED: ",AG("TOTPAT"),!!
- +8 ;D RTRN^AG
- +9 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +10 DO NEW
- DO EDIT
- +11 QUIT
- NEW IF ^TMP($JOB,AGBDT,"N")'>0
- QUIT
- +1 SET AG("HD")="THE FOLLOWING PATIENTS WERE ADDED:"
- DO HDR
- DO UCI1
- +2 FOR DFN=0:0
- SET DFN=$ORDER(^TMP($JOB,AGBDT,"N",DFN))
- IF 'DFN
- QUIT
- DO FILE
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +3 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +4 ;D RTRN^AG
- +5 QUIT
- EDIT IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +1 IF ^TMP($JOB,AGBDT,"E")'>0
- QUIT
- +2 SET AG("HD")="THE FOLLOWING PATIENT FILES WERE EDITED:"
- DO HDR
- DO UCI1
- +3 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,AGBDT,"E",DFN))
- IF 'DFN
- QUIT
- DO FILE
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +4 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +5 ;D RTRN^AG
- +6 QUIT
- END ;D RTRN^AG
- KILL AG("HAT")
- +1 ;W $$S^AGVDF("IOF") *** commited out to prevent control characters
- END1 DO ^%ZISC
- +1 KILL ^UTILITY("DIQ1",$JOB),^TMP($JOB),A,AG,AGBDT,AGIO,AGTIME,AGBM,DA,DIC,DR,AG("LOC"),AGPGPG,AGUCI,AG("USR"),X,Y
- +2 QUIT
- FILE WRITE ?5,$PIECE(^DPT(DFN,0),U),?43,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,AGGDUZ2,0),U,2),6)
- +1 ;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 I $D(^(DR)) W ?52,^(DR)
- +2 ;IHS/SD/TPF AG*7.1*4
- WRITE ?52,$$GET1^DIQ(9000001,DFN_",",1107.3)
- +3 ;S DR=.03 D EN^DIQ1 I $D(^(DR)) W ?66,$J(^(DR),10)
- +4 ;IHS/SD/TPF AG*7.1*4
- WRITE ?66,$JUSTIFY($PIECE($$GET1^DIQ(2,DFN_",",.03),"@"),10)
- +5 ;I $Y>AGBM D RTRN^AG Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
- WRITE !
- +6 QUIT
- HDR ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(11+$L(Y))\2,"Report for ",Y,!!
- +1 ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
- +2 ;BAR*1.8*4 IM26905
- SET AGPGPG=AGPGPG+1
- SET Y=AGBDT
- DO DD^%DT
- WRITE !!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$LENGTH(Y))\2,"Report from ",AGB," to ",AGE,!!
- +3 QUIT
- UCI1 IF '$DATA(AG("TOP"))
- WRITE ?80-$LENGTH(AG("HD"))\2,AG("HD"),!!,?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
- +1 KILL AG("TOP")
- +2 QUIT
