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

AVA93INS.m

Go to the documentation of this file. 
  1. AVA93INS ;IHS//RNB - AVA 93.2 INSTITUTION UPDATE ; 20 JULY 2010 2:45 PM
  1.  ;;93.2;VA SUPPORT FILES;**20**;JULY 20, 2010;Build 12
  1.  ;
  1.  ; Read through the INSTITUTION table looking to see if the station number
  1.  ; field is valued, if so then report the Institution:
  1.  ;      EIN code (subscript)
  1.  ;      Name (Piece 1 of the 0 node)
  1.  ;      value of station number (Piece 1 of the 99 node)
  1.  ;
  1.  ; AVASITE  - EIN for AUTTSITE reference
  1.  ; AVASITDT - Data string of AUTTSITE(EIN,0)
  1.  ; AVALOCPT - Location EIN for AUTTLOC
  1.  ; AVALOCDT - Data string of AUTTLOC(EIN,0)
  1.  ; AVAINTPT - EIN for DIC(4, INSTITUTION table
  1.  ; AVALASU  - ASUFAC number from the AUTTLOC data
  1.  ; AVAINTDT - Data string from the DIC(4,EIN,0) node
  1.  ; AVAINT99 - Data string from the DIC(4,EIN,99) node
  1.  ; AVAINTNM - Institution name field
  1.  ; AVASTAT  - Station number from DIC(4
  1.  ; STATION  - Station number to be assigned to the Institution
  1.  ; QQ       - Quit flag
  1.  ; 
  1.  Q
  1.  ;
  1. PRE ;
  1.  ; Check if site's Institution has the station field valued or not and if valued
  1.  ; that it is the correctly assigned one
  1.  ;
  1.  N AVASITE,AVASITDT,AVALOCPT,AVALOCDT,AVAINTPT,AVALASU,AVAINTDT,AVAINT99,AVAINTNM
  1.  N AVASTAT,STATION,QQ
  1.  S U="^",QQ=0
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM),!
  1.  ;
  1.  S %="STARTING PRE-PROCESS CHECKING" D MES^XPDUTL(%) W !
  1.  S %="CHECKING IF AUTTSITE's INSTITUTION HAS A STATION CODE ALREADY SET" D MES^XPDUTL(%) W !
  1.  ;
  1.  S AVASITE=0 F  S AVASITE=$O(^AUTTSITE(AVASITE)) Q:(AVASITE'?1N.N)  D CHK1
  1.  ;
  1.  S %="CHECKING IF ASUFAC HAS MULTIPLE LOCATION ASSOCIATED WITH IT" D MES^XPDUTL(%) W !
  1.  S %="RE-BUILDING 'C' INDEX FOR AUTTLOC" D MES^XPDUTL(%) W !
  1.  ;
  1.  ;Redo "C" index (index by ASUFAC Number)
  1.  D ^XBFMK
  1.  K ^AUTTLOC("C")
  1.  S DIK="^AUTTLOC("
  1.  S DIK(1)=".12^C"
  1.  D ENALL^DIK
  1.  ;
  1.  S AVALASU=0 F  S AVALASU=$O(^AUTTLOC("C",AVALASU)) Q:AVALASU=""  D CHK2
  1.  S ^XSTNUM(0)=QQ
  1.  I QQ D  
  1.  . S %="MUST CORRECT ANY OF THE INFORMATION DISPLAYED IN THIS PRE CHECK" D MES^XPDUTL(%)
  1.  . S %="CALL HELP-DESK FOR ASSISTANCE IF NEEDED" D MES^XPDUTL(%) H 4
  1.  . Q
  1.  I 'QQ D  
  1.  . W ! S %="NO ISSUES FOUND!" D MES^XPDUTL(%)  W !
  1.  . S %="PROCEED WITH LOADING STATION NUMBERS" D MES^XPDUTL(%)
  1.  . Q
  1.  Q
  1. CHK1 ;
  1.  ;
  1.  S AVASITDT=$G(^AUTTSITE(AVASITE,0))
  1.  S AVALOCPT=$P(AVASITDT,U,1)
  1.  I AVALOCPT="" S %="MESSAGE" D MES^XPDUTL(%) Q
  1.  S AVALOCDT=$G(^AUTTLOC(AVALOCPT,0))
  1.  S AVAINTPT=$P(AVALOCDT,U,1),AVALASU=$P(AVALOCDT,U,10)
  1.  I AVAINTPT="" S %="MESSAGE 2" D MES^XPDUTL(%) Q
  1.  I AVALASU="" S %="MESSAGE 2" D MES^XPDUTL(%) Q
  1.  S AVAINTDT=$G(^DIC(4,AVAINTPT,0))
  1.  S AVAINT99=$G(^DIC(4,AVAINTPT,99))
  1.  S AVAINTNM=$P(AVAINTDT,U,1)
  1.  S AVASTAT=$P(AVAINT99,U,1)
  1.  I AVASTAT'="" D  
  1.  . W !,"INSTITUTION NAME: ",AVAINTNM
  1.  . W !,"INSTITUTION CODE: ",AVAINTPT
  1.  . W !,?5,"STATION NUMBER: ",AVASTAT
  1.  . S STATION=$O(^XSTNUM("D",AVALASU_" ",""))
  1.  . I AVASTAT'=STATION W !,?5,"STATION NUMBER SHOULD BE: ",STATION
  1.  . I AVASTAT=STATION W !,?5,"STATION NUMBER IS ALREADY ASSIGNED CORRECTLY!",! Q
  1.  . S QQ=1
  1.  . Q
  1.  Q
  1. CHK2 ;
  1.  ;
  1.  K EXTRASU
  1.  S AVALC="",AVACNT=0
  1.  F  S AVALC=$O(^AUTTLOC("C",AVALASU,AVALC)) Q:AVALC=""  D  
  1.  . S AVALOCDT=$G(^AUTTLOC(AVALC,0))
  1.  . S AVALCNM=$P(AVALOCDT,U,2),AVAINTPT=$P(AVALOCDT,U,1),AVAINACT=$P(AVALOCDT,U,21)
  1.  . S AVAINTDT=$G(^DIC(4,AVAINTPT,0))
  1.  . S AVAINTNM=$P(AVAINTDT,U,1)
  1.  . I '$D(^DIC(4,AVAINTPT)) Q
  1.  . I AVAINACT'="" Q
  1.  . S EXTRASU(AVALC)=""
  1.  . S AVACNT=AVACNT+1
  1.  . Q
  1.  I AVACNT=1 K EXTRASU
  1.  I $D(EXTRASU) D  
  1.  . W !,"THERE ARE MULTIPLE LOCATION ASSOCIATED WITH THE ASUFAC: ",AVALASU
  1.  . S QQ=1
  1.  Q
  1.  ;
  1.  ; <<<<<<<  AFTER PRE CHECK  >>>>>>
  1.  ;
  1. PROCS ;
  1.  ; Set institution station number field
  1.  ; STNM     - station number assigned/to be assigned
  1.  ; AVALOCPT - EIN for AUTTLOC, location table
  1.  ; AVALOCDT - Data string from AUTTLOC(EIN,0)
  1.  ; AVAINTPT - EIN for DIC(4, Institution table
  1.  ; AVALASU  - ASUFAC number key for "C" index read of AUTTLOC("C"
  1.  ; AVAINTDT - Data string from DIC(4,EIN,0)
  1.  ; AVAINTNM - Institution name
  1.  ; EXTRASU  - Extra location reference for a single ASUFAC number flag/array
  1.  ; AVALC    - Location index for array EXTRASU
  1.  ; AVACNT   - Count variable for number of extra locations per ASUFAC numbers
  1.  ; AVALOCAF - ASUFAC (ASUFAC) reference from the 
  1.  ; STATION  - Station number to be assigned
  1.  ; QQ       - Quit flag
  1.  ; 
  1.  I $G(^XSTNUM(0))=1 D  Q
  1.  . S %="MUST CORRECT ANY OF THE INFORMATION DISPLAYED IN THIS PRE CHECK REPORT" D MES^XPDUTL(%)
  1.  . S %="CALL HELP-DESK FOR ASSISTANCE IF NEEDED" D MES^XPDUTL(%)
  1.  . Q
  1.  N AVALOCPT,AVALOCDT,AVAINTPT,AVALASU,AVAINTDT,AVAINTNM,EXTRASU,AVALC,AVACNT,AVALOCAF,STATION,QQ,NN
  1.  W !!,?5,"Institution Name",?45,"ASUFAC #",?54,"STATION NUMBER",!
  1.  F NN=1:1:80 W "_"
  1.  W !
  1.  S U="^",QQ=0
  1.  S AVALASU=0 F  S AVALASU=$O(^AUTTLOC("C",AVALASU)) Q:AVALASU=""  D PRC1
  1.  ;
  1.  ;Redo "D" index (index by station number)
  1.  W !
  1.  K ^DIC(4,"D")
  1.  S DIK="^DIC(4,"
  1.  S DIK(1)="99^D"
  1.  D ENALL^DIK
  1.  Q
  1. PRC1 ;
  1.  ;
  1.  K EXTRASU
  1.  S AVALC="",AVACNT=0
  1.  F  S AVALC=$O(^AUTTLOC("C",AVALASU,AVALC)) Q:AVALC=""  D  
  1.  . S AVALOCDT=$G(^AUTTLOC(AVALC,0))
  1.  . S AVALCNM=$P(AVALOCDT,U,2),AVAINTPT=$P(AVALOCDT,U,1),AVAINACT=$P(AVALOCDT,U,21)
  1.  . I '$D(^DIC(4,AVAINTPT)) Q
  1.  . I AVAINACT'="" Q
  1.  . S EXTRASU(AVALC)=""
  1.  . S AVACNT=AVACNT+1
  1.  . Q
  1.  I AVACNT>1 S %="MULTIPLE LOCATION ASSOCIATED WITH ASUFAC #: "_AVALASU D MES^XPDUTL(%) Q
  1.  S AVALOCPT="" F  S AVALOCPT=$O(EXTRASU(AVALOCPT)) Q:AVALOCPT=""  D PRC2
  1.  Q
  1. PRC2 ;
  1.  ;
  1.  S AVALOCDT=$G(^AUTTLOC(AVALOCPT,0))
  1.  S AVAINTPT=$P(AVALOCDT,U,1)
  1.  S AVALOCAF=$P(AVALOCDT,U,10)
  1.  I AVALOCAF'=AVALASU S %="ASUFAC NUMBER DOES NOT MATCH WITH INDEX: "_AVALOCAF_" TO "_AVALASU D MES^XPDUTL(%) Q
  1.  S AVAINTDT=$G(^DIC(4,AVAINTPT,0))
  1.  S AVAINTNM=$P(AVAINTDT,U,1)
  1.  I (AVALOCAF="") D  Q
  1.  . S %="ASUFAC IS NULL FOR LOCATION: "_AVAINTPT_" - "_AVALOCAF D MES^XPDUTL(%)
  1.  . Q
  1.  I $D(^XSTNUM("D",AVALASU_" "))=0 D  Q
  1.  . ;S %="ASUFAC "_AVALASU_" DOES NOT EXIST IN STATION NUMBER TEMP GLOBAL" D MES^XPDUTL(%)
  1.  . Q
  1.  S STATION=$O(^XSTNUM("D",AVALASU_" ",""))
  1.  W !,?5,AVAINTNM,?46,AVALASU,?60,STATION
  1.  S DA=AVAINTPT
  1.  S DR="99////"_STATION
  1.  S DIE="^DIC(4,"
  1.  S AUMDA=DA
  1.  D ^DIE
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
  1.  Q