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