GECSSITE ;WISC/RFJ/KLD-get site, fy, person data ;01 Nov 93
;;2.0;GCS;**6,15,27**;MAR 14, 1995
;
N %,%Y,DIC,DONTASK,I,X,Y
I $G(GECS("SITENOASK")) S DONTASK=GECS("SITENOASK")
K GECS
;
D GETUSER I '$D(GECS("PER")) Q
;
; find site
I '$O(^GECS(2101.7,0)) W !,"NO SITE PARAMETERS HAVE BEEN ENTERED IN FILE 2101.7," K GECS Q
I $P($G(^GECS(2101.7,0)),"^",4)'>1 D GETSITE(+$O(^GECS(2101.7,0))) Q
;
; if gecs("sitenoask") is defined (set in dontask), get param for site
I $G(DONTASK) D Q
. S %=+$O(^DIC(4,"D",+DONTASK,0)) I $D(^GECS(2101.7,%,0)) D GETSITE(%) Q
. W !,"SITE ",DONTASK," NOT FOUND IN FILE 2101.7." K GECS
;
S %=$P($G(^DIC(4,+$G(^GECS(2101.7,"PRIMARY")),0)),"^")
I %'="" S DIC("B")=%
S DIC("A")="Select STATION NUMBER"_$S($D(DIC("B")):" (^ TO EXIT)",1:"")_": ",DIC="^GECS(2101.7,",DIC(0)="AEQMN" W ! D ^DIC I Y'>0 Q
D GETSITE(+Y)
Q
;
;
GETSITE(GECSSITE) ; get site parameters for gecssite
N %,STATNAME,SUBSITE,SITE99
; get user if not defined
I '$D(GECS("PER")) D GETUSER I '$D(GECS("PER")) K GECS Q
;
S %=$G(^GECS(2101.7,+GECSSITE,0)) I %="" D
. W !!,"Site Missing From GENERIC CODE SHEET FILE 2101.7"
. W !,$$REPEAT^XLFSTR("*",57)
. W !,"Site ",GECS("SITE"),GECS("SITE1")," does not exist in File #2101.7. Please contact"
. W !,"your Information Resource Management(IRM) Personnel and"
. W !,"inform them that Site ",GECS("SITE"),GECS("SITE1")," must"
. W " be inserted into File"
. W !,"#2101.7 in order for you to continue with this option."
. W !,$$REPEAT^XLFSTR("*",57)
I %="" S SITEM=1 Q
I '+GECSSITE D
. I GECS("SITE") D
. . S SUBSITE=$O(^DIC(4,"D",GECS("SITE")_GECS("SITE1"),""))
. . I 'SUBSITE D
. . . W !!,"Site Missing From INSTITUTION FILE #4"
. . . W !,$$REPEAT^XLFSTR("*",51)
. . . W !,"Site ",GECS("SITE"),GECS("SITE1")," does not exit"
. . . W " in the INSTITUTION FILE #4"
. . . W !,"Please contact your Information Resource Management"
. . . W !,"(IRM) Personnel and inform them that Site "
. . . W GECS("SITE"),GECS("SITE1")," must"
. . . W !,"be inserted into File #4."
. . . W !,$$REPEAT^XLFSTR("*",51)
S STATNAME=$$GET1^DIQ(4,+GECSSITE,.01)
I STATNAME="" D
. S SITE99=$$GET1^DIQ(4,+GECSSITE,99) Q:'+SITE99
. W !!,"STATION NAME missing from INSTITUTION FILE #4"
. W !,$$REPEAT^XLFSTR("*",60)
. W !,"Site ",$$GET1^DIQ(4,+GECSSITE,99)," STATION NAME is not entered in Field #.01 of the"
. W !,"INSTITUTION FILE #4. Please inform your Information Resource"
. W !,"Management(IRM) Personnel."
. W !,$$REPEAT^XLFSTR("*",60)
I STATNAME="",+SITE99 Q
S %=$$GET1^DIQ(4,+GECSSITE,99) I %="" D
. W !!,"STATION NUMBER missing from INSTITUTION FILE #4"
. W !,$$REPEAT^XLFSTR("*",62)
. W !,"INTERNAL ENTRY NUMBER(IEN) "_GECSSITE_" does not have "
. W "a STATION NUMBER"
. W !,"entered in field #99 of the INSTITUTION FILE #4. Please "
. W "inform"
. W !,"your Information Resource Management(IRM) Personnel."
. W !,$$REPEAT^XLFSTR("*",62)
Q:%=""
S GECS("SITE")=$E(%,1,3),GECS("SITE1")=$E(%,4,6)
I '$G(GECSFNOP) W !,"Station: ",STATNAME," (#",%,")"
Q
;
;
GETUSER ; find user
N %,%H,%I,X,Y
S GECS("PER")=+$G(DUZ)_"^"_$P($G(^VA(200,+$G(DUZ),0)),"^")
I $P(GECS("PER"),"^",2)="" W !,"YOU ARE NOT AN AUTHORIZED USER. CONTACT IRM SERVICE" K GECS Q
D NOW^%DTC S Y=X X ^DD("DD") D
. S GECS("FY")=$S($E(X,4,5)<10:$P(Y,",",2),1:$P(Y,",",2)+1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSITE 3449 printed Dec 13, 2024@01:56:27 Page 2
GECSSITE ;WISC/RFJ/KLD-get site, fy, person data ;01 Nov 93
+1 ;;2.0;GCS;**6,15,27**;MAR 14, 1995
+2 ;
+3 NEW %,%Y,DIC,DONTASK,I,X,Y
+4 IF $GET(GECS("SITENOASK"))
SET DONTASK=GECS("SITENOASK")
+5 KILL GECS
+6 ;
+7 DO GETUSER
IF '$DATA(GECS("PER"))
QUIT
+8 ;
+9 ; find site
+10 IF '$ORDER(^GECS(2101.7,0))
WRITE !,"NO SITE PARAMETERS HAVE BEEN ENTERED IN FILE 2101.7,"
KILL GECS
QUIT
+11 IF $PIECE($GET(^GECS(2101.7,0)),"^",4)'>1
DO GETSITE(+$ORDER(^GECS(2101.7,0)))
QUIT
+12 ;
+13 ; if gecs("sitenoask") is defined (set in dontask), get param for site
+14 IF $GET(DONTASK)
Begin DoDot:1
+15 SET %=+$ORDER(^DIC(4,"D",+DONTASK,0))
IF $DATA(^GECS(2101.7,%,0))
DO GETSITE(%)
QUIT
+16 WRITE !,"SITE ",DONTASK," NOT FOUND IN FILE 2101.7."
KILL GECS
End DoDot:1
QUIT
+17 ;
+18 SET %=$PIECE($GET(^DIC(4,+$GET(^GECS(2101.7,"PRIMARY")),0)),"^")
+19 IF %'=""
SET DIC("B")=%
+20 SET DIC("A")="Select STATION NUMBER"_$SELECT($DATA(DIC("B")):" (^ TO EXIT)",1:"")_": "
SET DIC="^GECS(2101.7,"
SET DIC(0)="AEQMN"
WRITE !
DO ^DIC
IF Y'>0
QUIT
+21 DO GETSITE(+Y)
+22 QUIT
+23 ;
+24 ;
GETSITE(GECSSITE) ; get site parameters for gecssite
+1 NEW %,STATNAME,SUBSITE,SITE99
+2 ; get user if not defined
+3 IF '$DATA(GECS("PER"))
DO GETUSER
IF '$DATA(GECS("PER"))
KILL GECS
QUIT
+4 ;
+5 SET %=$GET(^GECS(2101.7,+GECSSITE,0))
IF %=""
Begin DoDot:1
+6 WRITE !!,"Site Missing From GENERIC CODE SHEET FILE 2101.7"
+7 WRITE !,$$REPEAT^XLFSTR("*",57)
+8 WRITE !,"Site ",GECS("SITE"),GECS("SITE1")," does not exist in File #2101.7. Please contact"
+9 WRITE !,"your Information Resource Management(IRM) Personnel and"
+10 WRITE !,"inform them that Site ",GECS("SITE"),GECS("SITE1")," must"
+11 WRITE " be inserted into File"
+12 WRITE !,"#2101.7 in order for you to continue with this option."
+13 WRITE !,$$REPEAT^XLFSTR("*",57)
End DoDot:1
+14 IF %=""
SET SITEM=1
QUIT
+15 IF '+GECSSITE
Begin DoDot:1
+16 IF GECS("SITE")
Begin DoDot:2
+17 SET SUBSITE=$ORDER(^DIC(4,"D",GECS("SITE")_GECS("SITE1"),""))
+18 IF 'SUBSITE
Begin DoDot:3
+19 WRITE !!,"Site Missing From INSTITUTION FILE #4"
+20 WRITE !,$$REPEAT^XLFSTR("*",51)
+21 WRITE !,"Site ",GECS("SITE"),GECS("SITE1")," does not exit"
+22 WRITE " in the INSTITUTION FILE #4"
+23 WRITE !,"Please contact your Information Resource Management"
+24 WRITE !,"(IRM) Personnel and inform them that Site "
+25 WRITE GECS("SITE"),GECS("SITE1")," must"
+26 WRITE !,"be inserted into File #4."
+27 WRITE !,$$REPEAT^XLFSTR("*",51)
End DoDot:3
End DoDot:2
End DoDot:1
+28 SET STATNAME=$$GET1^DIQ(4,+GECSSITE,.01)
+29 IF STATNAME=""
Begin DoDot:1
+30 SET SITE99=$$GET1^DIQ(4,+GECSSITE,99)
if '+SITE99
QUIT
+31 WRITE !!,"STATION NAME missing from INSTITUTION FILE #4"
+32 WRITE !,$$REPEAT^XLFSTR("*",60)
+33 WRITE !,"Site ",$$GET1^DIQ(4,+GECSSITE,99)," STATION NAME is not entered in Field #.01 of the"
+34 WRITE !,"INSTITUTION FILE #4. Please inform your Information Resource"
+35 WRITE !,"Management(IRM) Personnel."
+36 WRITE !,$$REPEAT^XLFSTR("*",60)
End DoDot:1
+37 IF STATNAME=""
IF +SITE99
QUIT
+38 SET %=$$GET1^DIQ(4,+GECSSITE,99)
IF %=""
Begin DoDot:1
+39 WRITE !!,"STATION NUMBER missing from INSTITUTION FILE #4"
+40 WRITE !,$$REPEAT^XLFSTR("*",62)
+41 WRITE !,"INTERNAL ENTRY NUMBER(IEN) "_GECSSITE_" does not have "
+42 WRITE "a STATION NUMBER"
+43 WRITE !,"entered in field #99 of the INSTITUTION FILE #4. Please "
+44 WRITE "inform"
+45 WRITE !,"your Information Resource Management(IRM) Personnel."
+46 WRITE !,$$REPEAT^XLFSTR("*",62)
End DoDot:1
+47 if %=""
QUIT
+48 SET GECS("SITE")=$EXTRACT(%,1,3)
SET GECS("SITE1")=$EXTRACT(%,4,6)
+49 IF '$GET(GECSFNOP)
WRITE !,"Station: ",STATNAME," (#",%,")"
+50 QUIT
+51 ;
+52 ;
GETUSER ; find user
+1 NEW %,%H,%I,X,Y
+2 SET GECS("PER")=+$GET(DUZ)_"^"_$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^")
+3 IF $PIECE(GECS("PER"),"^",2)=""
WRITE !,"YOU ARE NOT AN AUTHORIZED USER. CONTACT IRM SERVICE"
KILL GECS
QUIT
+4 DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
Begin DoDot:1
+5 SET GECS("FY")=$SELECT($EXTRACT(X,4,5)<10:$PIECE(Y,",",2),1:$PIECE(Y,",",2)+1)
End DoDot:1
+6 QUIT
