- AGRSSN1 ; IHS/ASDS/EFG - SSN COMPLIANCE REPORT FEB 6,1995 ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- K AG
- W $$S^AGVDF("IOF"),!!?13,"==================================================="
- W !?28,"SSN COMPLIANCE REPORT",!?13,"==================================================="
- W !!,"NOTE: This report might take considerable time to run, putting a large demand",!,"on the computer processor, which could adversely impact the response time on"
- W !,"other users. Thus, it is recommended that this report be queued to run at a time",!,"of limited activity. Contact your Site Manager for assistance with queueing."
- ;
- W !!!?10,"This REPORT can be limited to ACTIVE PATIENTS whom have",!?10,"had either a PCC or APC VISIT within the PAST 3 YEARS."
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to EXCLUDE report to ACTIVE PATIENTS ONLY",DIR("B")="Y" D ^DIR K DIR G XIT:$D(DTOUT)!$D(DUOUT),SLOC:'Y
- S AG("ACTIVE")=""
- SLOC W !!!?10,"Also, the REPORT can be restricted to a SPECIFIC LOCATION."
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to RESTRICT report to SPECIFIC LOCATION",DIR("B")="Y" D ^DIR K DIR G XIT:$D(DTOUT)!$D(DUOUT),ZIS:'Y
- W ! S DIC(0)="QEAM",DIC="^DIC(4,",DIC("A")="Restrict Report to Select LOCATION: ",DIC("B")=DUZ(2) D ^DIC G XIT:'+Y S AG("SLOC")=+Y
- ;
- ZIS W !!! S %ZIS="NQ",%ZIS("B")="",%ZIS("A")="Output DEVICE: " D ^%ZIS G:'$D(IO)!(POP) XIT
- S AG("IOP")=ION
- G:$D(IO("Q")) QUE
- PRQUE ;ENTER FROM TASK MANAGER
- K ^TMP("AG-SSN1",$J)
- S AG("HD",1)="",AG("HD")="SSN COMPLIANCE REPORT by Age Distribution"
- I $D(AG("ACTIVE")) S AG("HD",1)="for PATIENTS with VISITS in the PAST 3 YEARS "
- I $D(AG("SLOC")) S AG("HD",1)=AG("HD",1)_"at "_$E($P(^DIC(4,AG("SLOC"),0),U),1,30)
- K:AG("HD",1)="" AG("HD",1) S X1=DT,X2=-(365*3) D C^%DTC S AG("CUTOFF")=X G SLOOP:$D(AG("SLOC"))
- S AG=0 F AGZ("I")=1:1 S AG=$O(^DPT(AG)) Q:'+AG S AG("LOC")=0 F AGZ("I")=1:1 S AG("LOC")=$O(^AUPNPAT(AG,41,AG("LOC"))) Q:'+AG("LOC") S AG("HIT")=0 D DATA
- D WRT^AGRSSN1A G XIT
- SLOOP S AG=0,AG("LOC")=AG("SLOC") F AGZ("I")=1:1 S AG=$O(^DPT(AG)) Q:'+AG S AG("HIT")=0 D DATA
- D WRT^AGRSSN1A G XIT
- DATA I $D(AG("SLOC")) Q:'$D(^AUPNPAT(AG,41,AG("SLOC"),0))
- I $D(AG("ACTIVE")) D APC:'$D(^AUTTSITE(1,0)),PCC:$P(^(0),U,8)="Y",APC:'AG("HIT") Q:'AG("HIT")
- S AG("L")=$P($G(^DIC(4,AG("LOC"),0),"*** "_AG("LOC")_" ***"),U)
- S AG(0)=^DPT(AG,0),X1=DT,X2=$P(AG(0),U,3) D ^%DTC S X=X\365,X=$S(X<10:1,X<20:2,X<30:3,X<40:4,X<50:5,X<60:6,1:7),AG(1)=$S($P(AG(0),U,9)]"":1,1:0)
- I '$D(^TMP("AG-SSN1",$J,AG("L"),0)) S ^TMP("AG-SSN1",$J,AG("L"),0)=""
- S $P(^TMP("AG-SSN1",$J,AG("L"),0),U,X+7)=$P(^TMP("AG-SSN1",$J,AG("L"),0),U,X+7)+1 I AG(1) S $P(^(0),U,X)=$P(^(0),U,X)+1
- I '$D(^TMP("AG-SSN1",$J,0,0)) S ^TMP("AG-SSN1",$J,0,0)=0
- S $P(^TMP("AG-SSN1",$J,0,0),U,X+7)=$P(^TMP("AG-SSN1",$J,0,0),U,X+7)+1 I AG(1) S $P(^(0),U,X)=$P(^(0),U,X)+1
- Q
- PCC S AG("P")="" F AGZ("I")=1:1 S AG("P")=$O(^AUPNVSIT("AC",AG,AG("P"))) Q:'+AG("P") D Q:AG("HIT")
- .I $D(^AUPNVSIT(AG("P"),0)),$P(^(0),U,6)=AG("LOC"),+^(0)>AG("CUTOFF") S AG("HIT")=1
- Q
- APC S AG("P")="" F AGZ("I")=1:1 S AG("P")=$O(^AAPCRCDS("B",AG,AG("P"))) Q:'+AG("P") D Q:AG("HIT")
- .I $D(^AAPCRCDS(AG("P"),0)),$P(^(0),U,2)=AG("LOC"),$P(^(0),U,3)>AG("CUTOFF") S AG("HIT")=1
- Q
- XIT K AG,^TMP("AG-SSN1",$J)
- I '$D(DTOUT)!'$D(DTOUT)!'$D(DIROUT),IO=IO(0),$E(IOST)="C",'$D(IO("S")) W !! S DIR(0)="FO",DIR("A")="(REPORT COMPLETE)" D ^DIR K DIR
- D ^%ZISC
- I $D(ZTQUEUED) D KILL^%ZTLOAD
- Q
- QUE K IO("Q") S ZTRTN="PRQUE^AGRSSN1",ZTDESC="SSN STATS REPORT" F AG="DUZ(2)","DUZ(0)","AG(" S ZTSAVE(AG)=""
- D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED! (Task Number:",ZTSK,")",!
- K ZTSK G XIT
- AGRSSN1 ; IHS/ASDS/EFG - SSN COMPLIANCE REPORT FEB 6,1995 ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- +3 KILL AG
- +4 WRITE $$S^AGVDF("IOF"),!!?13,"==================================================="
- +5 WRITE !?28,"SSN COMPLIANCE REPORT",!?13,"==================================================="
- +6 WRITE !!,"NOTE: This report might take considerable time to run, putting a large demand",!,"on the computer processor, which could adversely impact the response time on"
- +7 WRITE !,"other users. Thus, it is recommended that this report be queued to run at a time",!,"of limited activity. Contact your Site Manager for assistance with queueing."
- +8 ;
- +9 WRITE !!!?10,"This REPORT can be limited to ACTIVE PATIENTS whom have",!?10,"had either a PCC or APC VISIT within the PAST 3 YEARS."
- +10 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to EXCLUDE report to ACTIVE PATIENTS ONLY"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF $DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)
- GOTO XIT
- IF 'Y
- GOTO SLOC
- +11 SET AG("ACTIVE")=""
- SLOC WRITE !!!?10,"Also, the REPORT can be restricted to a SPECIFIC LOCATION."
- +1 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to RESTRICT report to SPECIFIC LOCATION"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF $DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)
- GOTO XIT
- IF 'Y
- GOTO ZIS
- +2 WRITE !
- SET DIC(0)="QEAM"
- SET DIC="^DIC(4,"
- SET DIC("A")="Restrict Report to Select LOCATION: "
- SET DIC("B")=DUZ(2)
- DO ^DIC
- IF '+Y
- GOTO XIT
- SET AG("SLOC")=+Y
- +3 ;
- ZIS WRITE !!!
- SET %ZIS="NQ"
- SET %ZIS("B")=""
- SET %ZIS("A")="Output DEVICE: "
- DO ^%ZIS
- IF '$DATA(IO)!(POP)
- GOTO XIT
- +1 SET AG("IOP")=ION
- +2 IF $DATA(IO("Q"))
- GOTO QUE
- PRQUE ;ENTER FROM TASK MANAGER
- +1 KILL ^TMP("AG-SSN1",$JOB)
- +2 SET AG("HD",1)=""
- SET AG("HD")="SSN COMPLIANCE REPORT by Age Distribution"
- +3 IF $DATA(AG("ACTIVE"))
- SET AG("HD",1)="for PATIENTS with VISITS in the PAST 3 YEARS "
- +4 IF $DATA(AG("SLOC"))
- SET AG("HD",1)=AG("HD",1)_"at "_$EXTRACT($PIECE(^DIC(4,AG("SLOC"),0),U),1,30)
- +5 IF AG("HD",1)=""
- KILL AG("HD",1)
- SET X1=DT
- SET X2=-(365*3)
- DO C^%DTC
- SET AG("CUTOFF")=X
- IF $DATA(AG("SLOC"))
- GOTO SLOOP
- +6 SET AG=0
- FOR AGZ("I")=1:1
- SET AG=$ORDER(^DPT(AG))
- IF '+AG
- QUIT
- SET AG("LOC")=0
- FOR AGZ("I")=1:1
- SET AG("LOC")=$ORDER(^AUPNPAT(AG,41,AG("LOC")))
- IF '+AG("LOC")
- QUIT
- SET AG("HIT")=0
- DO DATA
- +7 DO WRT^AGRSSN1A
- GOTO XIT
- SLOOP SET AG=0
- SET AG("LOC")=AG("SLOC")
- FOR AGZ("I")=1:1
- SET AG=$ORDER(^DPT(AG))
- IF '+AG
- QUIT
- SET AG("HIT")=0
- DO DATA
- +1 DO WRT^AGRSSN1A
- GOTO XIT
- DATA IF $DATA(AG("SLOC"))
- IF '$DATA(^AUPNPAT(AG,41,AG("SLOC"),0))
- QUIT
- +1 IF $DATA(AG("ACTIVE"))
- IF '$DATA(^AUTTSITE(1,0))
- DO APC
- IF $PIECE(^(0),U,8)="Y"
- DO PCC
- IF 'AG("HIT")
- DO APC
- IF 'AG("HIT")
- QUIT
- +2 SET AG("L")=$PIECE($GET(^DIC(4,AG("LOC"),0),"*** "_AG("LOC")_" ***"),U)
- +3 SET AG(0)=^DPT(AG,0)
- SET X1=DT
- SET X2=$PIECE(AG(0),U,3)
- DO ^%DTC
- SET X=X\365
- SET X=$SELECT(X<10:1,X<20:2,X<30:3,X<40:4,X<50:5,X<60:6,1:7)
- SET AG(1)=$SELECT($PIECE(AG(0),U,9)]"":1,1:0)
- +4 IF '$DATA(^TMP("AG-SSN1",$JOB,AG("L"),0))
- SET ^TMP("AG-SSN1",$JOB,AG("L"),0)=""
- +5 SET $PIECE(^TMP("AG-SSN1",$JOB,AG("L"),0),U,X+7)=$PIECE(^TMP("AG-SSN1",$JOB,AG("L"),0),U,X+7)+1
- IF AG(1)
- SET $PIECE(^(0),U,X)=$PIECE(^(0),U,X)+1
- +6 IF '$DATA(^TMP("AG-SSN1",$JOB,0,0))
- SET ^TMP("AG-SSN1",$JOB,0,0)=0
- +7 SET $PIECE(^TMP("AG-SSN1",$JOB,0,0),U,X+7)=$PIECE(^TMP("AG-SSN1",$JOB,0,0),U,X+7)+1
- IF AG(1)
- SET $PIECE(^(0),U,X)=$PIECE(^(0),U,X)+1
- +8 QUIT
- PCC SET AG("P")=""
- FOR AGZ("I")=1:1
- SET AG("P")=$ORDER(^AUPNVSIT("AC",AG,AG("P")))
- IF '+AG("P")
- QUIT
- Begin DoDot:1
- +1 IF $DATA(^AUPNVSIT(AG("P"),0))
- IF $PIECE(^(0),U,6)=AG("LOC")
- IF +^(0)>AG("CUTOFF")
- SET AG("HIT")=1
- End DoDot:1
- IF AG("HIT")
- QUIT
- +2 QUIT
- APC SET AG("P")=""
- FOR AGZ("I")=1:1
- SET AG("P")=$ORDER(^AAPCRCDS("B",AG,AG("P")))
- IF '+AG("P")
- QUIT
- Begin DoDot:1
- +1 IF $DATA(^AAPCRCDS(AG("P"),0))
- IF $PIECE(^(0),U,2)=AG("LOC")
- IF $PIECE(^(0),U,3)>AG("CUTOFF")
- SET AG("HIT")=1
- End DoDot:1
- IF AG("HIT")
- QUIT
- +2 QUIT
- XIT KILL AG,^TMP("AG-SSN1",$JOB)
- +1 IF '$DATA">DATA">DATA">DATA(DTOUT)!'$DATA">DATA">DATA">DATA(DTOUT)!'$DATA">DATA">DATA">DATA(DIROUT)
- IF IO=IO(0)
- IF $EXTRACT(IOST)="C"
- IF '$DATA(IO("S"))
- WRITE !!
- SET DIR(0)="FO"
- SET DIR("A")="(REPORT COMPLETE)"
- DO ^DIR
- KILL DIR
- +2 DO ^%ZISC
- +3 IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +4 QUIT
- QUE KILL IO("Q")
- SET ZTRTN="PRQUE^AGRSSN1"
- SET ZTDESC="SSN STATS REPORT"
- FOR AG="DUZ(2)","DUZ(0)","AG("
- SET ZTSAVE(AG)=""
- +1 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED! (Task Number:",ZTSK,")",!
- +2 KILL ZTSK
- GOTO XIT
