AGSS0 ; IHS/ASDS/EFG - PROCESS NPIRS/SSA SUBMITTALS APR 14,1995 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
PROC ;EP - start processing
K ^AGSSTEMP(AGSSITE)
BY ;bypass
D OPEN^%ZISH("SSNFILE",AGSSPATH,AGSSHFL,"R")
I POP D Q
.S ^AGSSTEMP(AGSSITE,0,"NOPEN")=1
.I '$D(ZTQUEUED) W !!,*7,"Could not open file.",!
S AGSSFIO=IO
PROCESS ;>PROCESS RECORDS
K ^AGSSTEMP(AGSSITE,0,"STOP") ;external flag for stopping
S AGSITE=$P(^AUTTSITE(1,0),"^")
S ^AGSSTEMP(AGSSITE,0,"1ST-BEGIN-TIME")=$G(^AGSSTEMP(AGSSITE,0,"BEGIN-TIME"))
S ^AGSSTEMP(AGSSITE,0,"1ST-LAST-RECORD")=$G(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
S AGSBGTM=$H,^AGSSTEMP(AGSSITE,0,"BEGIN-TIME")=$H
S AGSSC=+$G(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
D COUNT
S AGSSRA=$G(^AGSSTEMP(AGSSITE,"TOT","RA"))
S AGSSRV=$G(^AGSSTEMP(AGSSITE,"TOT","RV"))
S AGSSRD=$G(^AGSSTEMP(AGSSITE,"TOT","RD"))
S AGSSRN=$G(^AGSSTEMP(AGSSITE,"TOT","RN"))
S AGSSRP=$G(^AGSSTEMP(AGSSITE,"TOT","RP"))
S AGSSRR=$G(^AGSSTEMP(AGSSITE,"TOT","RR"))
S AGSSRX=$G(^AGSSTEMP(AGSSITE,"TOT","RX"))
I $D(AGSS("NORUN")) G ENDPROC ;skip processing (SET MANUALLY) BEFORE STARTING
LOOP ;loop through host file
F D Q:$$STATUS^%ZISH!($D(^AGSSTEMP(AGSSITE,0,"STOP")))
.U AGSSFIO R AGSCREC Q:$$STATUS^%ZISH
.Q:$D(^AGSSTEMP(AGSSITE,0,"STOP"))
.S AGSSC=+$G(AGSSC)+1
.Q:AGSSC<$G(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
.D ^AGSS1
.S ^AGSSTEMP(AGSSITE,0,"LAST-RECORD")=AGSSC
.S ^AGSSTEMP(AGSSITE,0,"CURRENT-TIME")=$H
.Q:$D(ZTQUEUED)
.U IO(0)
.I '(AGSSC#100) W "."
.I '(AGSSC#1000) W AGSSC D DISP^AGSSM W !
S ^AGSSTEMP(AGSSITE,0,"END-PROCESS")=$H
D ^AGSSDEL ;> Process AGPATCH | DEL RECORDS | To NPIRS
S ^AGSSTEMP(AGSSITE,0,"END-DELTRAN")=$H
ENDPROC ;
S:$D(ZTQUEUED) XBFQ=1
Q
PRINT ;EP PRINT report of processing SSA SSNs
D COUNT
S AGHDDR="Report for SSA SSN Matching Application" D AGSSHDR
I $D(AGSS("NORUN")) W !,"NO RUN SET SO ... NO REPORT",! Q
S AGSSRTOT=$G(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
S ^AGSSTEMP(AGSSITE,"TOT","RR")=AGSSRTOT-^AGSSTEMP(AGSSITE,"TOT")
W !,"Records Processed from NPIRS/SSA ",?40,AGSSRTOT
S (AGSSBGT,%H)=$G(^AGSSTEMP(AGSSITE,0,"BEGIN-TIME")) D YX^%DTC
W !,"Starting Time",?40,Y
S (AGSSFNT,%H)=$G(^AGSSTEMP(AGSSITE,0,"END-DELTRAN")) D YX^%DTC
W !,"Ending Time",?40,Y
S AGSSDAY=(AGSSFNT/1)-(AGSSBGT/1)*24*60*60,AGSSSEC=AGSSDAY+($P(AGSSFNT,",",2))-($P(AGSSBGT,",",2)),AGSSMIN=AGSSSEC\60
W !,"Processing Time",?50,AGSSMIN," minutes"
W !!!,?2,"""A"" SSNs ADDED",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RA"),8)
W !!,?2,"""V"" SSNs VERIFIED",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RV"),8)
W !!,?2,"""N"" SSN NUMBERS differ but DATA agrees",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RN"),8)
W !!,?2,"""D"" DATA differs but SSN NUMBERS agree,",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RD"),8)
W !!,?2,"""P"" Possible SSNs for patients with a match",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RP"),8)
W !,?2,"to NPIRS HRN but either Name or DOB differs"
W !!,?2,"DELETES sent to NPIRS",?50,$J(^AGSSTEMP(AGSSITE,"TOT","DEL"),8)
W !!,?2,"""O"" Other",?50,$J(^AGSSTEMP(AGSSITE,"TOT","RR"),8),!
I '$D(ZTQUEUED) U IO(0) K DIR S DIR(0)="E" D ^DIR K DIR
Q
EXIT ;
D ^%ZISC
S AGK="AG" F S AGK=$O(@AGK) Q:((AGK="")!($E(AGK,1,2)'="AG")) I AGK'="AGK" K @AGK
K AG,AGK
Q
AGSSPG ;EP PAGE HANDLER
Q:($Y<(IOSL-4))!($G(DOUT)!$G(DFOUT)) S:'$D(AGSSPG) AGSSPG=0 S AGSSPG=AGSSPG+1 I $E(IOST)="C" R !,"^ to quit ",X:DTIME I $E(X)="^" S DOUT=1,DFOUT=1 Q
AGSSHDR ;EP PAGE HEADER HANDLER
W !,@IOF Q:'$D(AGSSHDR) S:'$D(AGSSLINE) $P(AGSSLINE,"-",IOM-2)="" S:'$D(AGSSPG) AGSSPG=1 I '$D(AGSSDT) D DT^DICRW S Y=DT D DD^%DT S AGSSDT=Y
W ?(IOM-20-$L(AGSSHDR)/2),AGSSHDR,?(IOM-25),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
EAGSSPG Q
STOP ;EP to stop background processing
S ^AGSSTEMP(AGSSITE,0,"STOP")=1
Q
COUNT ;count up entries
F I="RA","RV","RN","RD","RP","RX","DEL" D
.Q:$G(^AGSSTEMP(AGSSITE,"TOT",I))
.S AGSSCNT=0
.S J=0
.F S J=$O(^AGSSTEMP(AGSSITE,I,J)) Q:'J D
..S AGSSCNT=AGSSCNT+1
.S ^AGSSTEMP(AGSSITE,"TOT",I)=AGSSCNT
.S ^AGSSTEMP(AGSSITE,"TOT")=+$G(^AGSSTEMP(AGSSITE,"TOT"))+AGSSCNT
Q
AGSS0 ; IHS/ASDS/EFG - PROCESS NPIRS/SSA SUBMITTALS APR 14,1995 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
PROC ;EP - start processing
+1 KILL ^AGSSTEMP(AGSSITE)
BY ;bypass
+1 DO OPEN^%ZISH("SSNFILE",AGSSPATH,AGSSHFL,"R")
+2 IF POP
Begin DoDot:1
+3 SET ^AGSSTEMP(AGSSITE,0,"NOPEN")=1
+4 IF '$DATA(ZTQUEUED)
WRITE !!,*7,"Could not open file.",!
End DoDot:1
QUIT
+5 SET AGSSFIO=IO
PROCESS ;>PROCESS RECORDS
+1 ;external flag for stopping
KILL ^AGSSTEMP(AGSSITE,0,"STOP")
+1 SET AGSITE=$PIECE(^AUTTSITE(1,0),"^")
+2 SET ^AGSSTEMP(AGSSITE,0,"1ST-BEGIN-TIME")=$GET(^AGSSTEMP(AGSSITE,0,"BEGIN-TIME"))
+3 SET ^AGSSTEMP(AGSSITE,0,"1ST-LAST-RECORD")=$GET(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
+4 SET AGSBGTM=$HOROLOG
SET ^AGSSTEMP(AGSSITE,0,"BEGIN-TIME")=$HOROLOG
+5 SET AGSSC=+$GET(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
+6 DO COUNT
+7 SET AGSSRA=$GET(^AGSSTEMP(AGSSITE,"TOT","RA"))
+8 SET AGSSRV=$GET(^AGSSTEMP(AGSSITE,"TOT","RV"))
+9 SET AGSSRD=$GET(^AGSSTEMP(AGSSITE,"TOT","RD"))
+10 SET AGSSRN=$GET(^AGSSTEMP(AGSSITE,"TOT","RN"))
+11 SET AGSSRP=$GET(^AGSSTEMP(AGSSITE,"TOT","RP"))
+12 SET AGSSRR=$GET(^AGSSTEMP(AGSSITE,"TOT","RR"))
+13 SET AGSSRX=$GET(^AGSSTEMP(AGSSITE,"TOT","RX"))
+14 ;skip processing (SET MANUALLY) BEFORE STARTING
IF $DATA(AGSS("NORUN"))
GOTO ENDPROC
LOOP ;loop through host file
+1 FOR
Begin DoDot:1
+2 USE AGSSFIO
READ AGSCREC
IF $$STATUS^%ZISH
QUIT
+3 IF $DATA(^AGSSTEMP(AGSSITE,0,"STOP"))
QUIT
+4 SET AGSSC=+$GET(AGSSC)+1
+5 IF AGSSC<$GET(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
QUIT
+6 DO ^AGSS1
+7 SET ^AGSSTEMP(AGSSITE,0,"LAST-RECORD")=AGSSC
+8 SET ^AGSSTEMP(AGSSITE,0,"CURRENT-TIME")=$HOROLOG
+9 IF $DATA(ZTQUEUED)
QUIT
+10 USE IO(0)
+11 IF '(AGSSC#100)
WRITE "."
+12 IF '(AGSSC#1000)
WRITE AGSSC
DO DISP^AGSSM
WRITE !
End DoDot:1
IF $$STATUS^%ZISH!($DATA(^AGSSTEMP(AGSSITE,0,"STOP")))
QUIT
+13 SET ^AGSSTEMP(AGSSITE,0,"END-PROCESS")=$HOROLOG
+14 ;> Process AGPATCH | DEL RECORDS | To NPIRS
DO ^AGSSDEL
+15 SET ^AGSSTEMP(AGSSITE,0,"END-DELTRAN")=$HOROLOG
ENDPROC ;
+1 IF $DATA(ZTQUEUED)
SET XBFQ=1
+2 QUIT
PRINT ;EP PRINT report of processing SSA SSNs
+1 DO COUNT
+2 SET AGHDDR="Report for SSA SSN Matching Application"
DO AGSSHDR
+3 IF $DATA(AGSS("NORUN"))
WRITE !,"NO RUN SET SO ... NO REPORT",!
QUIT
+4 SET AGSSRTOT=$GET(^AGSSTEMP(AGSSITE,0,"LAST-RECORD"))
+5 SET ^AGSSTEMP(AGSSITE,"TOT","RR")=AGSSRTOT-^AGSSTEMP(AGSSITE,"TOT")
+6 WRITE !,"Records Processed from NPIRS/SSA ",?40,AGSSRTOT
+7 SET (AGSSBGT,%H)=$GET(^AGSSTEMP(AGSSITE,0,"BEGIN-TIME"))
DO YX^%DTC
+8 WRITE !,"Starting Time",?40,Y
+9 SET (AGSSFNT,%H)=$GET(^AGSSTEMP(AGSSITE,0,"END-DELTRAN"))
DO YX^%DTC
+10 WRITE !,"Ending Time",?40,Y
+11 SET AGSSDAY=(AGSSFNT/1)-(AGSSBGT/1)*24*60*60
SET AGSSSEC=AGSSDAY+($PIECE(AGSSFNT,",",2))-($PIECE(AGSSBGT,",",2))
SET AGSSMIN=AGSSSEC\60
+12 WRITE !,"Processing Time",?50,AGSSMIN," minutes"
+13 WRITE !!!,?2,"""A"" SSNs ADDED",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RA"),8)
+14 WRITE !!,?2,"""V"" SSNs VERIFIED",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RV"),8)
+15 WRITE !!,?2,"""N"" SSN NUMBERS differ but DATA agrees",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RN"),8)
+16 WRITE !!,?2,"""D"" DATA differs but SSN NUMBERS agree,",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RD"),8)
+17 WRITE !!,?2,"""P"" Possible SSNs for patients with a match",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RP"),8)
+18 WRITE !,?2,"to NPIRS HRN but either Name or DOB differs"
+19 WRITE !!,?2,"DELETES sent to NPIRS",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","DEL"),8)
+20 WRITE !!,?2,"""O"" Other",?50,$JUSTIFY(^AGSSTEMP(AGSSITE,"TOT","RR"),8),!
+21 IF '$DATA(ZTQUEUED)
USE IO(0)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+22 QUIT
EXIT ;
+1 DO ^%ZISC
+2 SET AGK="AG"
FOR
SET AGK=$ORDER(@AGK)
IF ((AGK="")!($EXTRACT(AGK,1,2)'="AG"))
QUIT
IF AGK'="AGK"
KILL @AGK
+3 KILL AG,AGK
+4 QUIT
AGSSPG ;EP PAGE HANDLER
+1 IF ($Y<(IOSL-4))!($GET(DOUT)!$GET(DFOUT))
QUIT
IF '$DATA(AGSSPG)
SET AGSSPG=0
SET AGSSPG=AGSSPG+1
IF $EXTRACT(IOST)="C"
READ !,"^ to quit ",X:DTIME
IF $EXTRACT(X)="^"
SET DOUT=1
SET DFOUT=1
QUIT
AGSSHDR ;EP PAGE HEADER HANDLER
+1 WRITE !,@IOF
IF '$DATA(AGSSHDR)
QUIT
IF '$DATA(AGSSLINE)
SET $PIECE(AGSSLINE,"-",IOM-2)=""
IF '$DATA(AGSSPG)
SET AGSSPG=1
IF '$DATA(AGSSDT)
DO DT^DICRW
SET Y=DT
DO DD^%DT
SET AGSSDT=Y
+2 WRITE ?(IOM-20-$LENGTH(AGSSHDR)/2),AGSSHDR,?(IOM-25),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
EAGSSPG QUIT
STOP ;EP to stop background processing
+1 SET ^AGSSTEMP(AGSSITE,0,"STOP")=1
+2 QUIT
COUNT ;count up entries
+1 FOR I="RA","RV","RN","RD","RP","RX","DEL"
Begin DoDot:1
+2 IF $GET(^AGSSTEMP(AGSSITE,"TOT",I))
QUIT
+3 SET AGSSCNT=0
+4 SET J=0
+5 FOR
SET J=$ORDER(^AGSSTEMP(AGSSITE,I,J))
IF 'J
QUIT
Begin DoDot:2
+6 SET AGSSCNT=AGSSCNT+1
End DoDot:2
+7 SET ^AGSSTEMP(AGSSITE,"TOT",I)=AGSSCNT
+8 SET ^AGSSTEMP(AGSSITE,"TOT")=+$GET(^AGSSTEMP(AGSSITE,"TOT"))+AGSSCNT
End DoDot:1
+9 QUIT
