AGSSSMR1 ;IHS/ASDS/SDH - SSA/SSN Matching Report ;
;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
;
;Changed all references to ^AGSSTEMP to ^AGSSTMP1
;
;This routine does NOT process records from SSA. This report
;simply goes through file, sorting by verification code in the
;file and generates a report. This routine does the first part,
;loading the global into a temp global. See AGSSSMR2 for output.
;
S ;EP - START
N AGACCTS
N DIR
S AGQUIT=""
S DIC="^AUTTLOC("
S DIC(0)="AEMQ"
S DIC("A")="Process Site: "
S DIC("B")=$P(^DIC(4,DUZ(2),0),"^",1)
D ^DIC K DIC
Q:Y<0
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K DTOUT,DUOUT,DIRUT,DIROUT,YQ
S AGSSITE=+Y
SELECT ;
W !?5,"V Verified SSNs"
W !?5,"1 SSNs not in file"
W !?5,"2 Name and DOB match,sex code doesn't"
W !?5,"3 Name and sex match, DOB doesn't"
W !?5,"4 Name matches, sex and DOB don't"
W !?5,"5 Name doesn't match,DOB and sex not checked"
W !?5,"* Not verified,SSA located different SSN based on name/DOB"
W !?5,"A Not verified,SSA found different SSN matching on name only"
W !?5,"B Not verified,SSA found different SSN matching on name/DOB"
W !?5,"C Not verified,Multiple SSNs found matching on name/DOB"
W !?5,"D Not verified,Multiple SSNs found matching on name only"
W !?5,"E Not verified,SSA found multiple matches for SSN"
W !?5,"F All error codes EXCEPT Verified"
W !?5,"G Complete report of ALL codes"
W !!?5,"Enter the list of codes you desire to print"
W !?5,"Example: 312*BD",!
S DIR("A")="Enter all error codes you wish to see on report"
S DIR(0)="FO^0:10"
D ^DIR K DIR
Q:Y=""
I Y[","!(Y["-") W !,"Do not separate codes with commas or hyphens!" H 2 G SELECT
Q:$D(DUOUT)!$D(DTOUT)!$D(DIRUT)!$D(DIROUT)
S Y=$$UPPER^AGUTILS(Y)
I $G(AGACCTS)'[Y S AGACCTS=$G(AGACCTS)_Y
Q:$G(Y)=""&($G(AGACCTS)="")
K Y
Q:$D(DUOUT)
;write what options were selected
W !!!,"Report will be written for the following codes:",!
F A=1:1:$L(AGACCTS) D
.S AGACCT=$E(AGACCTS,A)
.I AGACCT="V" S AGTXT="Verified SSNs"
.I AGACCT="1" S AGTXT="SSNs not in file"
.I AGACCT="2" S AGTXT="Name and DOB match,sex code doesn't"
.I AGACCT="3" S AGTXT="Name and sex match, DOB doesn't"
.I AGACCT="4" S AGTXT="Name matches, sex and DOB don't"
.I AGACCT="5" S AGTXT="Name doesn't match,DOB and sex not checked"
.I AGACCT="*" S AGTXT="SSA located different SSN based on name/DOB"
.I AGACCT="A" S AGTXT="SSA found different SSN matching on name only"
.I AGACCT="B" S AGTXT="SSA found different SSN matching on name/DOB"
.I AGACCT="C" S AGTXT="Multiple SSNs found matching on name/DOB"
.I AGACCT="D" S AGTXT="Multiple SSNs found matching on name only"
.I AGACCT="E" S AGTXT="SSA found multiple matches for SSN"
.I AGACCT="F" S AGTXT="All error codes EXCEPT Verified"
.I AGACCT="G" S AGTXT="Complete report of ALL codes"
.I U_"V"_U_"1"_U_"2"_U_"3"_U_"4"_U_"5"_U_"*"_"A"_U_"B"_U_"C"_U_"D"_U_"E"_U_"F"_U_"G"'[(U_AGACCT_U) S AGTXT="Removing improper code..." S AGACCTS=$TR(AGACCTS,AGACCT,"") ;IHS/SD/TPF 6/9/2008 IM29247
.W !,?5,AGACCT,?10,AGTXT
I AGACCTS="" H 3 G SELECT ;IHS/SD/TPF 6/9/2008 IM29247
;I "FG"'[$G(AGACCTS) D
I "FG"'[$G(AGACCTS) D G:Y=1 SELECT ;IHS/SD/TPF 6/9/2008 IM29247
.S DIR("A")="Do you want to enter more error codes?"
.S DIR(0)="Y"
.D ^DIR K DIR
.;I Y=1 K DTOUT D SELECT Q ;IHS/SD/TPF 6/9/2008 AG*7.1*4 IM29247
I $D(DUOUT) S AGQUIT=1 Q
I $G(AGQUIT)=1 K AGQUIT Q
I AGACCTS["F" S AGACCTS="12345*ABCDE"
I AGACCTS["G" S AGACCTS="12345*ABCDEV"
S AGQUIT=0
K Y
I $D(^AGSSTMP1(AGSSITE)) D Q:'Y!(AGQUIT=1)
.S DIR(0)="Y"
.S DIR("A")="Scratch global ^AGSSTMP1 exists for this site. Kill"
.S DIR("B")="N"
.D ^DIR K DIR
.I Y["^" S AGQUIT=1 Q
.I Y=0 D ^AGSSSMR2 S AGQUIT=1 Q
.K ^AGSSTMP1(AGSSITE)
I 'AGQUIT D
.S AGSSUFAC=$P(^AUTTLOC(AGSSITE,0),"^",10)
.S AGSSHFL="ss"_AGSSUFAC_".ssn"
.W !!,"Processing Host File: ",AGSSHFL,!
.S DIR(0)="F"
.S DIR("A")="Enter Directory Containing Above Host File"
.S DIR("B")="/usr/spool/uucppublic"
.D ^DIR K DIR S AGSSPATH=Y
.Q:AGSSPATH["^"
.I "\/"'[$E(AGSSPATH) D
..S:^%ZOSF("OS")["UNIX" AGSSPATH="/"_AGSSPATH Q
..S AGSSPATH="\"_AGSSPATH
.I "\/"'[$E(AGSSPATH,$L(AGSSPATH)) D
..S:^%ZOSF("OS")["UNIX" AGSSPATH=AGSSPATH_"/" Q
..S AGSSPATH=AGSSPATH_"\"
.D PROC
D EXIT
Q
PROC ;start processing
K AGSSCNT
U 0 W !,"READING INPUT FILE...."
BY ;bypass
D OPEN^%ZISH("SSNFILE",AGSSPATH,AGSSHFL,"R")
I POP D Q
.S ^AGSSTMP1(AGSSITE,0,"NOPEN")=1
.I '$D(ZTQUEUED) W !!,*7,"Could not open file.",!
S AGSSFIO=IO
PROCESS ;>PROCESS RECORDS
K ^AGSSTMP1(AGSSITE,0,"STOP") ;external flag for stopping
S AGSITE=$P(^AUTTSITE(1,0),"^")
S ^AGSSTMP1(AGSSITE,0,"1ST-BEGIN-TIME")=$G(^AGSSTMP1(AGSSITE,0,"BEGIN-TIME"))
S ^AGSSTMP1(AGSSITE,0,"1ST-LAST-RECORD")=$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
S AGSBGTM=$H,^AGSSTMP1(AGSSITE,0,"BEGIN-TIME")=$H
S AGSSC=+$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
I $D(AGSS("NORUN")) G EXIT ;skip processing (SET MANUALLY) BEFORE STARTING
LOOP ;loop through host file
S AGSSCNT("TOT")=1
F D Q:$$STATUS^%ZISH!($D(^AGSSTMP1(AGSSITE,0,"STOP")))
.U AGSSFIO R AGSCREC Q:$$STATUS^%ZISH
.Q:AGSCREC=""
.Q:$D(^AGSSTMP1(AGSSITE,0,"STOP"))
.Q:AGSSC<$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
.S ^AGSSTMP1(AGSSITE,0,"LAST-RECORD")=AGSSC
.S ^AGSSTMP1(AGSSITE,0,"CURRENT-TIME")=$H
.Q:$D(ZTQUEUED)
.S AGSSCVC=$P(AGSCREC,U,9)
.S AGSSHRN=$P(AGSCREC,U,2)
.S AGSSUFAC=$P(AGSCREC,U)
.S ^AGSSTMP1(AGSSITE,"RECS",AGSSUFAC,AGSSCVC,AGSSHRN,AGSSCNT("TOT"))=AGSCREC
.S AGSSCNT("TOT")=+$G(AGSSCNT("TOT"))+1
.S AGSSCNT(AGSSCVC)=+$G(AGSSCNT(AGSSCVC))+1
S ^AGSSTMP1(AGSSITE,0,"END-PROCESS")=$H
S ^AGSSTMP1(AGSSITE,0,"END-DELTRAN")=$H
S AGSSCVC=""
F S AGSSCVC=$O(AGSSCNT(AGSSCVC)) Q:AGSSCVC="" D
.I AGSSCVC["TOT" S AGSSCNT(AGSSCVC)=AGSSCNT(AGSSCVC)-1
.S ^AGSSTMP1(AGSSITE,0,"COUNTS",AGSSCVC)=$G(AGSSCNT(AGSSCVC))
S:$D(ZTQUEUED) XBFQ=1
D ^%ZISC ;IHS/SD/TPF 6/9/2008 AG*7.1*4 IM29060
D ^AGSSSMR2
D EXIT
Q
EXIT ;
D ^%ZISC
K AGSSHFL,AGSSQ,AGSSREC,AGSSVC,AGSSHRN,AGSSDOB,AGSSSEX
K AGHDDR,AGSBGTM,AGSCREC,AGSITE,AGSS1SSN,AGSS2SSN,AGSSBGT,AGSSC
K AGSSCNT,AGSSCVC,AGSSDAY,AGSSFIO,AGSSFN,AGSSFNT,AGSSLN,AGSSMIN
K AGSSMN,AGSSPATH,AGSSRTOT,AGSSSEC,AGSSUFAC,AGSSPICK
K Y,DIRUT,DIROUT,DTOUT,DUOUT
S AGK="AG" F S AGK=$O(@AGK) Q:((AGK="")!($E(AGK,1,2)'="AG")) I AGK'="AGK" K @AGK
K AG,AGK
Q
STOP ;EP - to stop background processing
S ^AGSSTMP1(AGSSITE,0,"STOP")=1
Q
AGSSSMR1 ;IHS/ASDS/SDH - SSA/SSN Matching Report ;
+1 ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
+2 ;
+3 ;Changed all references to ^AGSSTEMP to ^AGSSTMP1
+4 ;
+5 ;This routine does NOT process records from SSA. This report
+6 ;simply goes through file, sorting by verification code in the
+7 ;file and generates a report. This routine does the first part,
+8 ;loading the global into a temp global. See AGSSSMR2 for output.
+9 ;
S ;EP - START
+1 NEW AGACCTS
+2 NEW DIR
+3 SET AGQUIT=""
+4 SET DIC="^AUTTLOC("
+5 SET DIC(0)="AEMQ"
+6 SET DIC("A")="Process Site: "
+7 SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),"^",1)
+8 DO ^DIC
KILL DIC
+9 IF Y<0
QUIT
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
KILL DTOUT,DUOUT,DIRUT,DIROUT,YQ
+11 SET AGSSITE=+Y
SELECT ;
+1 WRITE !?5,"V Verified SSNs"
+2 WRITE !?5,"1 SSNs not in file"
+3 WRITE !?5,"2 Name and DOB match,sex code doesn't"
+4 WRITE !?5,"3 Name and sex match, DOB doesn't"
+5 WRITE !?5,"4 Name matches, sex and DOB don't"
+6 WRITE !?5,"5 Name doesn't match,DOB and sex not checked"
+7 WRITE !?5,"* Not verified,SSA located different SSN based on name/DOB"
+8 WRITE !?5,"A Not verified,SSA found different SSN matching on name only"
+9 WRITE !?5,"B Not verified,SSA found different SSN matching on name/DOB"
+10 WRITE !?5,"C Not verified,Multiple SSNs found matching on name/DOB"
+11 WRITE !?5,"D Not verified,Multiple SSNs found matching on name only"
+12 WRITE !?5,"E Not verified,SSA found multiple matches for SSN"
+13 WRITE !?5,"F All error codes EXCEPT Verified"
+14 WRITE !?5,"G Complete report of ALL codes"
+15 WRITE !!?5,"Enter the list of codes you desire to print"
+16 WRITE !?5,"Example: 312*BD",!
+17 SET DIR("A")="Enter all error codes you wish to see on report"
+18 SET DIR(0)="FO^0:10"
+19 DO ^DIR
KILL DIR
+20 IF Y=""
QUIT
+21 IF Y[","!(Y["-")
WRITE !,"Do not separate codes with commas or hyphens!"
HANG 2
GOTO SELECT
+22 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+23 SET Y=$$UPPER^AGUTILS(Y)
+24 IF $GET(AGACCTS)'[Y
SET AGACCTS=$GET(AGACCTS)_Y
+25 IF $GET(Y)=""&($GET(AGACCTS)="")
QUIT
+26 KILL Y
+27 IF $DATA(DUOUT)
QUIT
+28 ;write what options were selected
+29 WRITE !!!,"Report will be written for the following codes:",!
+30 FOR A=1:1:$LENGTH(AGACCTS)
Begin DoDot:1
+31 SET AGACCT=$EXTRACT(AGACCTS,A)
+32 IF AGACCT="V"
SET AGTXT="Verified SSNs"
+33 IF AGACCT="1"
SET AGTXT="SSNs not in file"
+34 IF AGACCT="2"
SET AGTXT="Name and DOB match,sex code doesn't"
+35 IF AGACCT="3"
SET AGTXT="Name and sex match, DOB doesn't"
+36 IF AGACCT="4"
SET AGTXT="Name matches, sex and DOB don't"
+37 IF AGACCT="5"
SET AGTXT="Name doesn't match,DOB and sex not checked"
+38 IF AGACCT="*"
SET AGTXT="SSA located different SSN based on name/DOB"
+39 IF AGACCT="A"
SET AGTXT="SSA found different SSN matching on name only"
+40 IF AGACCT="B"
SET AGTXT="SSA found different SSN matching on name/DOB"
+41 IF AGACCT="C"
SET AGTXT="Multiple SSNs found matching on name/DOB"
+42 IF AGACCT="D"
SET AGTXT="Multiple SSNs found matching on name only"
+43 IF AGACCT="E"
SET AGTXT="SSA found multiple matches for SSN"
+44 IF AGACCT="F"
SET AGTXT="All error codes EXCEPT Verified"
+45 IF AGACCT="G"
SET AGTXT="Complete report of ALL codes"
+46 ;IHS/SD/TPF 6/9/2008 IM29247
IF U_"V"_U_"1"_U_"2"_U_"3"_U_"4"_U_"5"_U_"*"_"A"_U_"B"_U_"C"_U_"D"_U_"E"_U_"F"_U_"G"'[(U_AGACCT_U)
SET AGTXT="Removing improper code..."
SET AGACCTS=$TRANSLATE(AGACCTS,AGACCT,"")
+47 WRITE !,?5,AGACCT,?10,AGTXT
End DoDot:1
+48 ;IHS/SD/TPF 6/9/2008 IM29247
IF AGACCTS=""
HANG 3
GOTO SELECT
+49 ;I "FG"'[$G(AGACCTS) D
+50 ;IHS/SD/TPF 6/9/2008 IM29247
IF "FG"'[$GET(AGACCTS)
Begin DoDot:1
+51 SET DIR("A")="Do you want to enter more error codes?"
+52 SET DIR(0)="Y"
+53 DO ^DIR
KILL DIR
+54 ;I Y=1 K DTOUT D SELECT Q ;IHS/SD/TPF 6/9/2008 AG*7.1*4 IM29247
End DoDot:1
IF Y=1
GOTO SELECT
+55 IF $DATA(DUOUT)
SET AGQUIT=1
QUIT
+56 IF $GET(AGQUIT)=1
KILL AGQUIT
QUIT
+57 IF AGACCTS["F"
SET AGACCTS="12345*ABCDE"
+58 IF AGACCTS["G"
SET AGACCTS="12345*ABCDEV"
+59 SET AGQUIT=0
+60 KILL Y
+61 IF $DATA(^AGSSTMP1(AGSSITE))
Begin DoDot:1
+62 SET DIR(0)="Y"
+63 SET DIR("A")="Scratch global ^AGSSTMP1 exists for this site. Kill"
+64 SET DIR("B")="N"
+65 DO ^DIR
KILL DIR
+66 IF Y["^"
SET AGQUIT=1
QUIT
+67 IF Y=0
DO ^AGSSSMR2
SET AGQUIT=1
QUIT
+68 KILL ^AGSSTMP1(AGSSITE)
End DoDot:1
IF 'Y!(AGQUIT=1)
QUIT
+69 IF 'AGQUIT
Begin DoDot:1
+70 SET AGSSUFAC=$PIECE(^AUTTLOC(AGSSITE,0),"^",10)
+71 SET AGSSHFL="ss"_AGSSUFAC_".ssn"
+72 WRITE !!,"Processing Host File: ",AGSSHFL,!
+73 SET DIR(0)="F"
+74 SET DIR("A")="Enter Directory Containing Above Host File"
+75 SET DIR("B")="/usr/spool/uucppublic"
+76 DO ^DIR
KILL DIR
SET AGSSPATH=Y
+77 IF AGSSPATH["^"
QUIT
+78 IF "\/"'[$EXTRACT(AGSSPATH)
Begin DoDot:2
+79 IF ^%ZOSF("OS")["UNIX"
SET AGSSPATH="/"_AGSSPATH
QUIT
+80 SET AGSSPATH="\"_AGSSPATH
End DoDot:2
+81 IF "\/"'[$EXTRACT(AGSSPATH,$LENGTH(AGSSPATH))
Begin DoDot:2
+82 IF ^%ZOSF("OS")["UNIX"
SET AGSSPATH=AGSSPATH_"/"
QUIT
+83 SET AGSSPATH=AGSSPATH_"\"
End DoDot:2
+84 DO PROC
End DoDot:1
+85 DO EXIT
+86 QUIT
PROC ;start processing
+1 KILL AGSSCNT
+2 USE 0
WRITE !,"READING INPUT FILE...."
BY ;bypass
+1 DO OPEN^%ZISH("SSNFILE",AGSSPATH,AGSSHFL,"R")
+2 IF POP
Begin DoDot:1
+3 SET ^AGSSTMP1(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 ^AGSSTMP1(AGSSITE,0,"STOP")
+1 SET AGSITE=$PIECE(^AUTTSITE(1,0),"^")
+2 SET ^AGSSTMP1(AGSSITE,0,"1ST-BEGIN-TIME")=$GET(^AGSSTMP1(AGSSITE,0,"BEGIN-TIME"))
+3 SET ^AGSSTMP1(AGSSITE,0,"1ST-LAST-RECORD")=$GET(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
+4 SET AGSBGTM=$HOROLOG
SET ^AGSSTMP1(AGSSITE,0,"BEGIN-TIME")=$HOROLOG
+5 SET AGSSC=+$GET(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
+6 ;skip processing (SET MANUALLY) BEFORE STARTING
IF $DATA(AGSS("NORUN"))
GOTO EXIT
LOOP ;loop through host file
+1 SET AGSSCNT("TOT")=1
+2 FOR
Begin DoDot:1
+3 USE AGSSFIO
READ AGSCREC
IF $$STATUS^%ZISH
QUIT
+4 IF AGSCREC=""
QUIT
+5 IF $DATA(^AGSSTMP1(AGSSITE,0,"STOP"))
QUIT
+6 IF AGSSC<$GET(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
QUIT
+7 SET ^AGSSTMP1(AGSSITE,0,"LAST-RECORD")=AGSSC
+8 SET ^AGSSTMP1(AGSSITE,0,"CURRENT-TIME")=$HOROLOG
+9 IF $DATA(ZTQUEUED)
QUIT
+10 SET AGSSCVC=$PIECE(AGSCREC,U,9)
+11 SET AGSSHRN=$PIECE(AGSCREC,U,2)
+12 SET AGSSUFAC=$PIECE(AGSCREC,U)
+13 SET ^AGSSTMP1(AGSSITE,"RECS",AGSSUFAC,AGSSCVC,AGSSHRN,AGSSCNT("TOT"))=AGSCREC
+14 SET AGSSCNT("TOT")=+$GET(AGSSCNT("TOT"))+1
+15 SET AGSSCNT(AGSSCVC)=+$GET(AGSSCNT(AGSSCVC))+1
End DoDot:1
IF $$STATUS^%ZISH!($DATA(^AGSSTMP1(AGSSITE,0,"STOP")))
QUIT
+16 SET ^AGSSTMP1(AGSSITE,0,"END-PROCESS")=$HOROLOG
+17 SET ^AGSSTMP1(AGSSITE,0,"END-DELTRAN")=$HOROLOG
+18 SET AGSSCVC=""
+19 FOR
SET AGSSCVC=$ORDER(AGSSCNT(AGSSCVC))
IF AGSSCVC=""
QUIT
Begin DoDot:1
+20 IF AGSSCVC["TOT"
SET AGSSCNT(AGSSCVC)=AGSSCNT(AGSSCVC)-1
+21 SET ^AGSSTMP1(AGSSITE,0,"COUNTS",AGSSCVC)=$GET(AGSSCNT(AGSSCVC))
End DoDot:1
+22 IF $DATA(ZTQUEUED)
SET XBFQ=1
+23 ;IHS/SD/TPF 6/9/2008 AG*7.1*4 IM29060
DO ^%ZISC
+24 DO ^AGSSSMR2
+25 DO EXIT
+26 QUIT
EXIT ;
+1 DO ^%ZISC
+2 KILL AGSSHFL,AGSSQ,AGSSREC,AGSSVC,AGSSHRN,AGSSDOB,AGSSSEX
+3 KILL AGHDDR,AGSBGTM,AGSCREC,AGSITE,AGSS1SSN,AGSS2SSN,AGSSBGT,AGSSC
+4 KILL AGSSCNT,AGSSCVC,AGSSDAY,AGSSFIO,AGSSFN,AGSSFNT,AGSSLN,AGSSMIN
+5 KILL AGSSMN,AGSSPATH,AGSSRTOT,AGSSSEC,AGSSUFAC,AGSSPICK
+6 KILL Y,DIRUT,DIROUT,DTOUT,DUOUT
+7 SET AGK="AG"
FOR
SET AGK=$ORDER(@AGK)
IF ((AGK="")!($EXTRACT(AGK,1,2)'="AG"))
QUIT
IF AGK'="AGK"
KILL @AGK
+8 KILL AG,AGK
+9 QUIT
STOP ;EP - to stop background processing
+1 SET ^AGSSTMP1(AGSSITE,0,"STOP")=1
+2 QUIT
