Routine: AGGWCHC

AGGWCHC ;VNGT/HS/ALA-Return 'Choice' values for the GUI ; 08 Apr 2010  3:32 PM

 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

EN(DATA,VFILE,CODE) ;EP -- AGG GET WINDOW CHOICE

 ;Input

 ;  VFILE - The vfile number or name

 ;  CODE  - The parameter name

 NEW UID,II,HDR,IEN,VALUE,HELP,VFIEN,HN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGWCHC",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="No Window selected" Q

 S VFIEN=$$FIND1^DIC(9009068.3,"","MX",VFILE,"","","ERROR")

 S CODE=$G(CODE,"") I CODE="" S BMXSEC="No code given" Q

 I $O(^AGG(9009068.3,VFIEN,10,"AC",CODE,""))="" S BMXSEC="Code does not exist for this Window" Q

 NEW DA,IENS

 S DA(2)=VFIEN,DA(1)=$O(^AGG(9009068.3,VFIEN,10,"AC",CODE,""))

 S HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE^T00001VALIDATION^T00008HELP_ASSOC^T01024CHOICE_HELP"_$C(30)

 S @DATA@(II)=HDR

 I $O(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",""))="" D STD

 I $O(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",""))'="" D NST

DONE ;

 S II=II+1,@DATA@(II)=$C(31)

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

NST ; Sort in designated order

 NEW ORD

 S ORD=""

 F  S ORD=$O(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",ORD,IEN)) Q:IEN=""  D REC

STD ; Sort in standard order

 S IEN=0

 F  S IEN=$O(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN)) Q:'IEN  D REC

REC ; Get record values

 I $P(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,0),U,5)=1 Q

 S DA=IEN,IENS=$$IENS^DILF(.DA),VALUE=""

 S VALUE=VALUE_$$GET1^DIQ(9009068.315,IENS,.01,"E")_U_$$GET1^DIQ(9009068.315,IENS,.02,"E")_U_$$GET1^DIQ(9009068.315,IENS,.03,"I")_U

 S VALUE=VALUE_$$GET1^DIQ(9009068.315,IENS,.04,"E")_U

 S HN=0,HELP=""

 F  S HN=$O(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,1,HN)) Q:'HN  D

 . S HELP=HELP_^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,1,HN,0)_$C(10)

 S HELP=$$TKO^AGGUL1(HELP,$C(10))

 S VALUE=VALUE_HELP_$C(30)

 S II=II+1,@DATA@(II)=VALUE

AGGWCHC   ;VNGT/HS/ALA-Return 'Choice' values for the GUI ; 08 Apr 2010  3:32 PM

 +1       ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 +2       ;

 +3        QUIT

 +4       ;

EN(DATA,VFILE,CODE) ;EP -- AGG GET WINDOW CHOICE

 +1       ;

 +2       ;Input

 +3       ;  VFILE - The vfile number or name

 +4       ;  CODE  - The parameter name

 +5       ;

 +6        NEW UID,II,HDR,IEN,VALUE,HELP,VFIEN,HN

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET DATA=$NAME(^TMP("AGGWCHC",UID))

 +9        KILL @DATA

 +10       SET II=0

 +11      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGWCHC D UNWIND^%ZTER"

 +12       SET VFILE=$GET(VFILE,"")

           IF VFILE=""

               SET BMXSEC="No Window selected"

               QUIT

 +13       SET VFIEN=$$FIND1^DIC(9009068.3,"","MX",VFILE,"","","ERROR")

 +14       SET CODE=$GET(CODE,"")

           IF CODE=""

               SET BMXSEC="No code given"

               QUIT

 +15       IF $ORDER(^AGG(9009068.3,VFIEN,10,"AC",CODE,""))=""

               SET BMXSEC="Code does not exist for this Window"

               QUIT

 +16       NEW DA,IENS

 +17       SET DA(2)=VFIEN

           SET DA(1)=$ORDER(^AGG(9009068.3,VFIEN,10,"AC",CODE,""))

 +18      ;

 +19       SET HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE^T00001VALIDATION^T00008HELP_ASSOC^T01024CHOICE_HELP"_$CHAR(30)

 +20       SET @DATA@(II)=HDR

 +21      ;

 +22       IF $ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",""))=""

               DO STD

 +23       IF $ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",""))'=""

               DO NST

 +24      ;

DONE      ;

 +1        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +2        QUIT

 +3       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT

 +7       ;

NST       ; Sort in designated order

 +1        NEW ORD

 +2        SET ORD=""

 +3        FOR

               SET ORD=$ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",ORD))

               IF ORD=""

                   QUIT

               Begin DoDot:1

 +4                SET IEN=""

 +5                FOR

                       SET IEN=$ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,"AC",ORD,IEN))

                       IF IEN=""

                           QUIT

                       DO REC

               End DoDot:1

 +6        QUIT

 +7       ;

STD       ; Sort in standard order

 +1        SET IEN=0

 +2        FOR

               SET IEN=$ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN))

               IF 'IEN

                   QUIT

               DO REC

 +3        QUIT

 +4       ;

REC       ; Get record values

 +1        IF $PIECE(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,0),U,5)=1

               QUIT

 +2        SET DA=IEN

           SET IENS=$$IENS^DILF(.DA)

           SET VALUE=""

 +3        SET VALUE=VALUE_$$GET1^DIQ(9009068.315,IENS,.01,"E")_U_$$GET1^DIQ(9009068.315,IENS,.02,"E")_U_$$GET1^DIQ(9009068.315,IENS,.03,"I")_U

 +4        SET VALUE=VALUE_$$GET1^DIQ(9009068.315,IENS,.04,"E")_U

 +5        SET HN=0

           SET HELP=""

 +6        FOR

               SET HN=$ORDER(^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,1,HN))

               IF 'HN

                   QUIT

               Begin DoDot:1

 +7                SET HELP=HELP_^AGG(9009068.3,VFIEN,10,DA(1),5,IEN,1,HN,0)_$CHAR(10)

               End DoDot:1

 +8        SET HELP=$$TKO^AGGUL1(HELP,$CHAR(10))

 +9        SET VALUE=VALUE_HELP_$CHAR(30)

 +10       SET II=II+1

           SET @DATA@(II)=VALUE

 +11       QUIT

AGGWCHC.m