- 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 Feb 18, 2025@23:22:49 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