AGVAR.m

AGVAR ; IHS/ASDS/EFG - SET REGISTRATION VARIABLES ;

 ;;7.1;PATIENT REGISTRATION;**1,2,8,9,10,12**;AUG 25, 2005;Build 1

 ;IHS/OIT/NKD AG*7.1*12 ZIP+4

 ;

 ;ADDED UNDOCUMENTED ESCAPE FEATURE FOR EDIT CHECKS.

 ;IF ERRORS APPEAR SPECS REQUIRE FIELD TO BE FIXED BEFORE ALLOWING

 ;EXIT VARIABLE AGOPT("ESCAPE") CONTAINS THE STRING TO ESCAPE THIS

 ;

 ; IHS/OIT/NKD AG*7.1*12 - ACTIVATE ZIP+4 - START OLD CODE

 ;N X,DPTFLAG

 ;I $D(^DIC(9.4,"C","DPT")) D

 ;. S X=$$VERSION^XPDUTL("DPT")

 ;. I X>5 S DPTFLAG=""

 ; AG*7.1*12 - END OLD CODE - START NEW CODE

 K DPTFLAG

 S:$$VERSION^XPDUTL("DPT")>5 DPTFLAG=""

 ; AG*7.1*12 - END NEW CODE

 S AG("QUIT")=""

 I '$D(^AGFAC(DUZ(2))) G BAD

 K AGOPT

 ;AG*7.1*8 - Changed from 25 to 26 to include new LINK AOB TO ROI FIELD parameter

 ;AG*7.1*9 - Changed from 26 to 28 to include Disp MIGRANT WORKER and Disp HOMELESS parameter

 F AG=2:1:28 G:$P($G(^AGFAC(DUZ(2),0)),U,AG)="" BAD S AGOPT(AG-1)=$P(^(0),U,AG)

 I '$D(DTIME) S DTIME=300

 I '$D(DT) D

 . S %DT=""

 . S X="T"

 . D ^%DT

 . S DT=Y

 ;D VIDEO^AG  ;IHS/SD/SDR 4/7/11 HEAT31913

 I $G(IOST(0))'="" D VIDEO^AG  ;IHS/SD/SDR 4/7/11 HEAT31913

 S AGOPT("ESCAPE")="+++"

 S AGOPT("AGE OF MINOR")=18  ;IHS/SD/TPF AG*7.1*1 ITEM 18

 S AGOPT("VERSION")=$$VERSION^XPDUTL("AG")  ;GET CURRENT VERSION EDIT CHECKS WILL BE PERFORMED DIFFERENTLY ON SOME FIELDS BECAUSE VERSION 7.1 CHANGED THEIR LOCATION

END ;

 Q

BAD ;

 W *7,!,"The REGISTRATION PARAMETERS file has not been completed for this facility."

 W !!,"Please contact your system support person.",!!

 S (XQUIT,AG("QUIT"))=1

 K DIR

 S DIR("A")="Press RETURN..."

 S DIR(0)="E"

 D ^DIR

 K DIR

 G END

AGVAR     ; IHS/ASDS/EFG - SET REGISTRATION VARIABLES ;

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,8,9,10,12**;AUG 25, 2005;Build 1

 +2       ;IHS/OIT/NKD AG*7.1*12 ZIP+4

 +3       ;

 +4       ;ADDED UNDOCUMENTED ESCAPE FEATURE FOR EDIT CHECKS.

 +5       ;IF ERRORS APPEAR SPECS REQUIRE FIELD TO BE FIXED BEFORE ALLOWING

 +6       ;EXIT VARIABLE AGOPT("ESCAPE") CONTAINS THE STRING TO ESCAPE THIS

 +7       ;

 +8       ; IHS/OIT/NKD AG*7.1*12 - ACTIVATE ZIP+4 - START OLD CODE

 +9       ;N X,DPTFLAG

 +10      ;I $D(^DIC(9.4,"C","DPT")) D

 +11      ;. S X=$$VERSION^XPDUTL("DPT")

 +12      ;. I X>5 S DPTFLAG=""

 +13      ; AG*7.1*12 - END OLD CODE - START NEW CODE

 +14       KILL DPTFLAG

 +15       IF $$VERSION^XPDUTL("DPT")>5

               SET DPTFLAG=""

 +16      ; AG*7.1*12 - END NEW CODE

 +17       SET AG("QUIT")=""

 +18       IF '$DATA(^AGFAC(DUZ(2)))

               GOTO BAD

 +19       KILL AGOPT

 +20      ;AG*7.1*8 - Changed from 25 to 26 to include new LINK AOB TO ROI FIELD parameter

 +21      ;AG*7.1*9 - Changed from 26 to 28 to include Disp MIGRANT WORKER and Disp HOMELESS parameter

 +22       FOR AG=2:1:28

               IF $PIECE($GET(^AGFAC(DUZ(2),0)),U,AG)=""

                   GOTO BAD

               SET AGOPT(AG-1)=$PIECE(^(0),U,AG)

 +23       IF '$DATA(DTIME)

               SET DTIME=300

 +24       IF '$DATA(DT)

               Begin DoDot:1

 +25               SET %DT=""

 +26               SET X="T"

 +27               DO ^%DT

 +28               SET DT=Y

               End DoDot:1

 +29      ;D VIDEO^AG  ;IHS/SD/SDR 4/7/11 HEAT31913

 +30      ;IHS/SD/SDR 4/7/11 HEAT31913

           IF $GET(IOST(0))'=""

               DO VIDEO^AG

 +31       SET AGOPT("ESCAPE")="+++"

 +32      ;IHS/SD/TPF AG*7.1*1 ITEM 18

           SET AGOPT("AGE OF MINOR")=18

 +33      ;GET CURRENT VERSION EDIT CHECKS WILL BE PERFORMED DIFFERENTLY ON SOME FIELDS BECAUSE VERSION 7.1 CHANGED THEIR LOCATION

           SET AGOPT("VERSION")=$$VERSION^XPDUTL("AG")

END       ;

 +1        QUIT 

BAD       ;

 +1        WRITE *7,!,"The REGISTRATION PARAMETERS file has not been completed for this facility."

 +2        WRITE !!,"Please contact your system support person.",!!

 +3        SET (XQUIT,AG("QUIT"))=1

 +4        KILL DIR

 +5        SET DIR("A")="Press RETURN..."

 +6        SET DIR(0)="E"

 +7        DO ^DIR

 +8        KILL DIR

 +9        GOTO END