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

PXQMAIN2.m

Go to the documentation of this file. 
  1. PXQMAIN2 ;ISL/JVS - MAIN MENU ROUTINE #3 ;8/29/96  10:33
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
  1.  ;
  1.  ;--OPTION 9
  1.  N LOC9,NAME,PAT9,POP,Y
  1.  S DIR("A")="Select a Display"
  1.  S DIR(0)="SOM^P:Patient files;L:Location files"
  1.  D ^DIR I Y=""!(Y["^") G CLOSE
  1.  I Y="P" D PAT G MENU
  1.  I Y="L" D LOC G MENU
  1.  K DIR("A"),DIR(0)
  1.  G CLOSE
  1.  ;
  1. PAT ;--PATIENT FILES
  1.  ;--GENERAL ERRORS IN THE DATA BASE
  1.  ;--OPEN DEVICE
  1.  S OPTION="9P"
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. PAT9P ;--BODY
  1.  N PAT,I,PXQRECI,SSN,SSN1,FLAG1,FLAG2,FLAG3,PAT2,LOC
  1.  N PAT2,LOC4,FLAG4,FLAG5
  1.  S PXQRECI=0
  1.  I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL("   ERROR    ")
  1.  I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL("** NO CROSS-REFERENCE IN FILE#2 ON SSN FIELD FOR UPDATING FILE#9000001**")
  1.  I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL("** CROSS-REFERENCE COMES WITH PATIENT/IHS SUBSET PACKAGE**"),$$RE^PXQUTL(" ")
  1.  W $$RE^PXQUTL("Compare of #2 and # 9000001 Patient files"),$$RE^PXQUTL(" ")
  1.  S PAT=$$PTFLE^PXQUTL
  1.  S PAT2="^DPT(0) = "_$G(^DPT(0)),PAT9="^AUPNPAT(0) = "_$G(^AUPNPAT(0))
  1.  W $$RE^PXQUTL("     "_PAT2),$$RE^PXQUTL("     "_PAT9)
  1.  I $P(PAT,"^",1)=$P(PAT,"^",2) W $$RE^PXQUTL("      Zero Nodes MATCH")
  1.  I $P(PAT,"^",1)'=$P(PAT,"^",2) W $$RE^PXQUTL("      Zero Nodes DO NOT Match")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  ;
  1.  I IOST["C-" D WAIT^DICD
  1.  N PXQCNT,PXQLIMIT
  1.  S PXQCNT=0,PXQLIMIT=100
  1.  S I=0 F  S I=$O(^DPT(I)) Q:I'>0  Q:PXQCNT>PXQLIMIT  I '$D(^AUPNPAT(I)) D
  1.  .S PXQCNT=PXQCNT+1
  1.  .I '$G(FLAG1) W $$RE^PXQUTL("Patients in file #2 but not in #9000001"),$$RE^PXQUTL(" DFN         NAME                  SSN") S FLAG1=1
  1.  .S NAME=$P($G(^DPT(I,0)),"^",1),SSN=$P($G(^DPT(I,0)),"^",9)
  1.  .W $$RE^PXQUTL(""""_I_""",?10,"""_$E(NAME,1,20)_""",?32,"""_SSN_"""")
  1.  W $$RE^PXQUTL(" ")
  1.  I PXQCNT>PXQLIMIT W $$RE^PXQUTL("**There are more that 100 of these so I'll quit with 100**")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  S I=0 F  S I=$O(^AUPNPAT(I)) Q:I'>0  I '$D(^DPT(I)) D
  1.  .I '$G(FLAG2) W $$RE^PXQUTL("Patients in file #9000001 but not in #2"),$$RE^PXQUTL(" DFN         NAME                  SSN") S FLAG2=1
  1.  .S NAME="**UNKNOWN**",SSN1=$P($G(^AUPNPAT(I,41,+$$SITE^VASITE,0)),"^",2)
  1.  .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_""",?32,"""_SSN1_"""")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  S I=0 F  S I=$O(^DPT(I)) Q:I'>0  I $D(^AUPNPAT(I)) D
  1.  .S NAME=$P($G(^DPT(I,0)),"^",1),SSN=$P($G(^DPT(I,0)),"^",9),SSN1=$P($G(^AUPNPAT(I,41,+$$SITE^VASITE,0)),"^",2)
  1.  .I SSN'=SSN1 D
  1.  ..I '$G(FLAG3) W $$RE^PXQUTL("SSN'S in #2 not equal to #9000001"),$$RE^PXQUTL(" DFN        NAME                   #2        #9000001") S FLAG3=1
  1.  ..W $$RE^PXQUTL(""""_I_""",?10,"""_$E(NAME,1,20)_""",?32,"""_SSN_""",?45,"""_SSN1_"""")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  ;
  1.  I $P(PAT,"^",1)=$P(PAT,"^",2) D
  1.  .I '$G(FLAG1) W $$RE^PXQUTL("PATIENT file #2 and PATIENT/IHS file #9000001 are in sync.")
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G CLOSE
  1.  E  Q
  1.  ;
  1. LOC ;--LOCATION FILES
  1.  ;--GENERAL ERRORS IN THE DATA BASE
  1.  ;--OPEN DEVICE
  1.  S OPTION="9L"
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. LOC9L ;--BODY
  1.  N PAT,I,PXQRECI,SSN,SSN1,FLAG1,FLAG2,FLAG3,PAT2,LOC
  1.  N PAT2,LOC4,FLAG4,FLAG5
  1.  S PXQRECI=0
  1.  ;--location files
  1.  W $$RE^PXQUTL("Compare of #4 and # 9999999.06 location files"),$$RE^PXQUTL(" ")
  1.  S LOC=$$LCFLE^PXQUTL
  1.  S LOC4="^DIC(4,0) = "_$G(^DIC(4,0)),LOC9="^AUTTLOC(0) = "_$G(^AUTTLOC(0))
  1.  W $$RE^PXQUTL("     "_LOC4),$$RE^PXQUTL("     "_LOC9)
  1.  I $P(LOC,"^",1)=$P(LOC,"^",2) W $$RE^PXQUTL("      Zero Nodes MATCH")
  1.  I $P(LOC,"^",1)'=$P(LOC,"^",2) W $$RE^PXQUTL("      Zero Nodes DO NOT Match")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  ;
  1.  I IOST["C-" D WAIT^DICD
  1.  ;
  1.  S I=0 F  S I=$O(^DIC(4,I)) Q:I'>0  I '$D(^AUTTLOC(I)) D
  1.  .I '$G(FLAG4) W $$RE^PXQUTL("Locations in file #4 but not in #9999999.06"),$$RE^PXQUTL(" IEN         NAME") S FLAG4=1
  1.  .S NAME=$P($G(^DIC(4,I,0)),"^",1)
  1.  .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_"""")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  S I=0 F  S I=$O(^AUTTLOC(I)) Q:I'>0  I '$D(^DIC(4,I)) D
  1.  .I '$G(FLAG5) W $$RE^PXQUTL("Locations in file #9999999.06 but not in #4"),$$RE^PXQUTL(" IEN         NAME") S FLAG5=1
  1.  .S NAME="**UNKNOWN**"
  1.  .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_"""")
  1.  W $$RE^PXQUTL(" ")
  1.  ;
  1.  I $P(LOC,"^",1)=$P(LOC,"^",2) D
  1.  .I '$G(FLAG4) W $$RE^PXQUTL("INSTITUTION file #4 and LOCATION file #9999999.06 are in sync.")
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G CLOSE
  1.  E  Q
  1.  ;
  1. CLOSE ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  K OPTION
  1.  ;--RETURN TO MENU
  1.  ;R !,"Press any key to return to the menu",ANS:DTIME
  1.  Q
  1.  ;
  1. EXIT ;--EXIT
  1.  K OPTION
  1.  Q