Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGSSSMR1

AGSSSMR1.m

Go to the documentation of this file. 
  1. AGSSSMR1 ;IHS/ASDS/SDH - SSA/SSN Matching Report  ;  
  1.  ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
  1.  ;
  1.  ;Changed all references to ^AGSSTEMP to ^AGSSTMP1
  1.  ;
  1.  ;This routine does NOT process records from SSA.  This report
  1.  ;simply goes through file, sorting by verification code in the
  1.  ;file and generates a report.  This routine does the first part,
  1.  ;loading the global into a temp global.  See AGSSSMR2 for output.
  1.  ;
  1. S ;EP - START
  1.  N AGACCTS
  1.  N DIR
  1.  S AGQUIT=""
  1.  S DIC="^AUTTLOC("
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Process Site: "
  1.  S DIC("B")=$P(^DIC(4,DUZ(2),0),"^",1)
  1.  D ^DIC K DIC
  1.  Q:Y<0
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K DTOUT,DUOUT,DIRUT,DIROUT,YQ
  1.  S AGSSITE=+Y
  1. SELECT ;
  1.  W !?5,"V   Verified SSNs"
  1.  W !?5,"1   SSNs not in file"
  1.  W !?5,"2   Name and DOB match,sex code doesn't"
  1.  W !?5,"3   Name and sex match, DOB doesn't"
  1.  W !?5,"4   Name matches, sex and DOB don't"
  1.  W !?5,"5   Name doesn't match,DOB and sex not checked"
  1.  W !?5,"*   Not verified,SSA located different SSN based on name/DOB"
  1.  W !?5,"A   Not verified,SSA found different SSN matching on name only"
  1.  W !?5,"B   Not verified,SSA found different SSN matching on name/DOB"
  1.  W !?5,"C   Not verified,Multiple SSNs found matching on name/DOB"
  1.  W !?5,"D   Not verified,Multiple SSNs found matching on name only"
  1.  W !?5,"E   Not verified,SSA found multiple matches for SSN"
  1.  W !?5,"F   All error codes EXCEPT Verified"
  1.  W !?5,"G   Complete report of ALL codes"
  1.  W !!?5,"Enter the list of codes you desire to print"
  1.  W !?5,"Example:  312*BD",!
  1.  S DIR("A")="Enter all error codes you wish to see on report"
  1.  S DIR(0)="FO^0:10"
  1.  D ^DIR K DIR
  1.  Q:Y=""
  1.  I Y[","!(Y["-") W !,"Do not separate codes with commas or hyphens!" H 2 G SELECT
  1.  Q:$D(DUOUT)!$D(DTOUT)!$D(DIRUT)!$D(DIROUT)
  1.  S Y=$$UPPER^AGUTILS(Y)
  1.  I $G(AGACCTS)'[Y S AGACCTS=$G(AGACCTS)_Y
  1.  Q:$G(Y)=""&($G(AGACCTS)="")
  1.  K Y
  1.  Q:$D(DUOUT)
  1.  ;write what options were selected
  1.  W !!!,"Report will be written for the following codes:",!
  1.  F A=1:1:$L(AGACCTS) D
  1.  .S AGACCT=$E(AGACCTS,A)
  1.  .I AGACCT="V" S AGTXT="Verified SSNs"
  1.  .I AGACCT="1" S AGTXT="SSNs not in file"
  1.  .I AGACCT="2" S AGTXT="Name and DOB match,sex code doesn't"
  1.  .I AGACCT="3" S AGTXT="Name and sex match, DOB doesn't"
  1.  .I AGACCT="4" S AGTXT="Name matches, sex and DOB don't"
  1.  .I AGACCT="5" S AGTXT="Name doesn't match,DOB and sex not checked"
  1.  .I AGACCT="*" S AGTXT="SSA located different SSN based on name/DOB"
  1.  .I AGACCT="A" S AGTXT="SSA found different SSN matching on name only"
  1.  .I AGACCT="B" S AGTXT="SSA found different SSN matching on name/DOB"
  1.  .I AGACCT="C" S AGTXT="Multiple SSNs found matching on name/DOB"
  1.  .I AGACCT="D" S AGTXT="Multiple SSNs found matching on name only"
  1.  .I AGACCT="E" S AGTXT="SSA found multiple matches for SSN"
  1.  .I AGACCT="F" S AGTXT="All error codes EXCEPT Verified"
  1.  .I AGACCT="G" S AGTXT="Complete report of ALL codes"
  1.  .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
  1.  .W !,?5,AGACCT,?10,AGTXT
  1.  I AGACCTS="" H 3 G SELECT  ;IHS/SD/TPF 6/9/2008 IM29247
  1.  ;I "FG"'[$G(AGACCTS) D
  1.  I "FG"'[$G(AGACCTS) D  G:Y=1 SELECT  ;IHS/SD/TPF 6/9/2008 IM29247
  1.  .S DIR("A")="Do you want to enter more error codes?"
  1.  .S DIR(0)="Y"
  1.  .D ^DIR K DIR
  1.  .;I Y=1 K DTOUT D SELECT Q  ;IHS/SD/TPF 6/9/2008 AG*7.1*4 IM29247
  1.  I $D(DUOUT) S AGQUIT=1 Q
  1.  I $G(AGQUIT)=1 K AGQUIT Q
  1.  I AGACCTS["F" S AGACCTS="12345*ABCDE"
  1.  I AGACCTS["G" S AGACCTS="12345*ABCDEV"
  1.  S AGQUIT=0
  1.  K Y
  1.  I $D(^AGSSTMP1(AGSSITE)) D  Q:'Y!(AGQUIT=1)
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Scratch global ^AGSSTMP1 exists for this site. Kill"
  1.  .S DIR("B")="N"
  1.  .D ^DIR K DIR
  1.  .I Y["^" S AGQUIT=1 Q
  1.  .I Y=0 D ^AGSSSMR2 S AGQUIT=1 Q
  1.  .K ^AGSSTMP1(AGSSITE)
  1.  I 'AGQUIT D
  1.  .S AGSSUFAC=$P(^AUTTLOC(AGSSITE,0),"^",10)
  1.  .S AGSSHFL="ss"_AGSSUFAC_".ssn"
  1.  .W !!,"Processing Host File: ",AGSSHFL,!
  1.  .S DIR(0)="F"
  1.  .S DIR("A")="Enter Directory Containing Above Host File"
  1.  .S DIR("B")="/usr/spool/uucppublic"
  1.  .D ^DIR K DIR S AGSSPATH=Y
  1.  .Q:AGSSPATH["^"
  1.  .I "\/"'[$E(AGSSPATH) D
  1.  ..S:^%ZOSF("OS")["UNIX" AGSSPATH="/"_AGSSPATH Q
  1.  ..S AGSSPATH="\"_AGSSPATH
  1.  .I "\/"'[$E(AGSSPATH,$L(AGSSPATH)) D
  1.  ..S:^%ZOSF("OS")["UNIX" AGSSPATH=AGSSPATH_"/" Q
  1.  ..S AGSSPATH=AGSSPATH_"\"
  1.  .D PROC
  1.  D EXIT
  1.  Q
  1. PROC ;start processing
  1.  K AGSSCNT
  1.  U 0 W !,"READING INPUT FILE...."
  1. BY ;bypass
  1.  D OPEN^%ZISH("SSNFILE",AGSSPATH,AGSSHFL,"R")
  1.  I POP D  Q
  1.  .S ^AGSSTMP1(AGSSITE,0,"NOPEN")=1
  1.  .I '$D(ZTQUEUED) W !!,*7,"Could not open file.",!
  1.  S AGSSFIO=IO
  1. PROCESS ;>PROCESS RECORDS
  1.  K ^AGSSTMP1(AGSSITE,0,"STOP") ;external flag for stopping
  1.  S AGSITE=$P(^AUTTSITE(1,0),"^")
  1.  S ^AGSSTMP1(AGSSITE,0,"1ST-BEGIN-TIME")=$G(^AGSSTMP1(AGSSITE,0,"BEGIN-TIME"))
  1.  S ^AGSSTMP1(AGSSITE,0,"1ST-LAST-RECORD")=$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
  1.  S AGSBGTM=$H,^AGSSTMP1(AGSSITE,0,"BEGIN-TIME")=$H
  1.  S AGSSC=+$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
  1.  I $D(AGSS("NORUN")) G EXIT ;skip processing (SET MANUALLY) BEFORE STARTING
  1. LOOP ;loop through host file
  1.  S AGSSCNT("TOT")=1
  1.  F  D  Q:$$STATUS^%ZISH!($D(^AGSSTMP1(AGSSITE,0,"STOP")))
  1.  .U AGSSFIO R AGSCREC Q:$$STATUS^%ZISH
  1.  .Q:AGSCREC=""
  1.  .Q:$D(^AGSSTMP1(AGSSITE,0,"STOP"))
  1.  .Q:AGSSC<$G(^AGSSTMP1(AGSSITE,0,"LAST-RECORD"))
  1.  .S ^AGSSTMP1(AGSSITE,0,"LAST-RECORD")=AGSSC
  1.  .S ^AGSSTMP1(AGSSITE,0,"CURRENT-TIME")=$H
  1.  .Q:$D(ZTQUEUED)
  1.  .S AGSSCVC=$P(AGSCREC,U,9)
  1.  .S AGSSHRN=$P(AGSCREC,U,2)
  1.  .S AGSSUFAC=$P(AGSCREC,U)
  1.  .S ^AGSSTMP1(AGSSITE,"RECS",AGSSUFAC,AGSSCVC,AGSSHRN,AGSSCNT("TOT"))=AGSCREC
  1.  .S AGSSCNT("TOT")=+$G(AGSSCNT("TOT"))+1
  1.  .S AGSSCNT(AGSSCVC)=+$G(AGSSCNT(AGSSCVC))+1
  1.  S ^AGSSTMP1(AGSSITE,0,"END-PROCESS")=$H
  1.  S ^AGSSTMP1(AGSSITE,0,"END-DELTRAN")=$H
  1.  S AGSSCVC=""
  1.  F  S AGSSCVC=$O(AGSSCNT(AGSSCVC)) Q:AGSSCVC=""  D
  1.  .I AGSSCVC["TOT" S AGSSCNT(AGSSCVC)=AGSSCNT(AGSSCVC)-1
  1.  .S ^AGSSTMP1(AGSSITE,0,"COUNTS",AGSSCVC)=$G(AGSSCNT(AGSSCVC))
  1.  S:$D(ZTQUEUED) XBFQ=1
  1.  D ^%ZISC  ;IHS/SD/TPF 6/9/2008 AG*7.1*4  IM29060
  1.  D ^AGSSSMR2
  1.  D EXIT
  1.  Q
  1. EXIT ;
  1.  D ^%ZISC
  1.  K AGSSHFL,AGSSQ,AGSSREC,AGSSVC,AGSSHRN,AGSSDOB,AGSSSEX
  1.  K AGHDDR,AGSBGTM,AGSCREC,AGSITE,AGSS1SSN,AGSS2SSN,AGSSBGT,AGSSC
  1.  K AGSSCNT,AGSSCVC,AGSSDAY,AGSSFIO,AGSSFN,AGSSFNT,AGSSLN,AGSSMIN
  1.  K AGSSMN,AGSSPATH,AGSSRTOT,AGSSSEC,AGSSUFAC,AGSSPICK
  1.  K Y,DIRUT,DIROUT,DTOUT,DUOUT
  1.  S AGK="AG" F  S AGK=$O(@AGK) Q:((AGK="")!($E(AGK,1,2)'="AG"))  I AGK'="AGK" K @AGK
  1.  K AG,AGK
  1.  Q
  1. STOP ;EP - to stop background processing
  1.  S ^AGSSTMP1(AGSSITE,0,"STOP")=1
  1.  Q