APCDEFL.m

APCDEFL ; IHS/CMI/LAB - EDIT VISIT LIST TEMP ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;; ;

 ; -- PUBLIC ENTRY POINT to edit visit

 ; -- calling routine must pass visit ien in APCDVSIT

 ; -- calling routine responsible for killing APCDVSIT

 ; -- calling routine responsible for killing APCD vars - D ^APCDEKL

 ;

EN ;PEP -- main entry point for APCDEF VISIT DISPLAY

 NEW DFN,APCDPARM,APCDOVRR

 K ^TMP("APCDEFG",$J)

 Q:'$G(APCDVSIT)

 D EP^APCDEFG(APCDVSIT)

 S DFN=$$VALI^XBDIQ1(9000010,APCDVSIT,.05)

 S Y=DFN D ^AUPNPAT ; pcc needs the AUPN variables set

 I '$D(^APCDSITE(DUZ(2),0)) W !!,"The DATA ENTRY Site Parameters have not been",!,"established for this facility.  PLEASE NOTIFY YOUR SUPERVISOR!",$C(7),$C(7) D DEFAULT^APCDVAR Q

 D ^APCDEIN

 D EN^VALM("APCDEF VISIT DISPLAY")

 D CLEAR^VALM1

 K ^TMP("APCDEFG",$J),APCDBROW,APCDOVRR

 Q

 ;

EN1 ;EP - called from input templates

 D EN^XBNEW("EN^APCDEFL","APCDVSIT")

 K Y

 Q

HDR ; -- header code

 ;S VALMHDR(1)="This is a test header for APCD VISIT DISPLAY."

 ;S VALMHDR(2)="This is the second line"

 Q

 ;

INIT ; -- init variables and list array

 S VALMCNT=$O(^TMP("APCDEFG",$J,"IDX"),-1)

 S VALMSG="-  Prev Screen     Q  Quit     ?? for More Actions"

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K AUPNVSIT,APCDNUM,VALMCNT,VALMSG

 Q

 ;

EXPND ; -- expand code

 Q

 ;

GETITEM ; -- select item from list

 K APCDDR

 D EN^VALM2(XQORNOD(0),"OS")

 I '$D(VALMY) W !!,"No item selected!" Q

 S APCDDR=$O(VALMY(0))

 D CLEAR^VALM1,FULL^VALM1

 Q

RESET ;

 K ^TMP("APCDEFG",$J)

 S VALMBCK="R" D EP^APCDEFG(APCDVSIT) D INIT Q

 ;

PAUSE ;

 N DIR S DIR(0)="E",DIR("A")="Press ENTER to continue" D ^DIR Q

 ;

EDIT ;EP; called by edit/delete action

 NEW APCDDR,APCDMNE,APCDPAT,APCDCAT,APCDTYPE,APCDLOC,APCDVLK,APCDDATE,APCDMODE,APCDCLN,APCDOVRR

 D GETITEM I '$D(APCDDR) S VALMBCK="R" W !!,$C(7),$C(7),"That is not an editable item, please see your supervisor for assistance.",! H 3 D INIT Q

 S APCDDR=$G(^TMP("APCDEFG",$J,"MNE",APCDDR))

 I '$G(APCDDR) S VALMBCK="R" W !!,$C(7),$C(7),"That is not an editable item, please see your supervisor for assistance.",! H 3 D INIT Q

 S APCDMNE=APCDDR,APCDMNE("NAME")=$P(^APCDTKW(APCDDR,0),U)

 S APCDMODE="M",APCDVLK=APCDVSIT D VINIT(APCDMNE)

 D ^APCDEA3

 D RESET Q

 ;

ADD(M,APCDVSIT) ;EP; called by actions to add v file entries

 NEW APCDMNE,APCDPAT,APCDCAT,APCDTYPE,APCDLOC,APCDVLK,APCDDATE,APCDMODE

 D CLEAR^VALM1,FULL^VALM1

 S APCDMNE=$O(^APCDTKW("B",M,0)) Q:APCDMNE=""

 W !!,"Adding ",$P(^APCDTKW(APCDMNE,0),U,12),!!

 S APCDMODE="A" D VINIT(APCDMNE)

 D ^APCDEA3

 D RESET Q

 ;

ADD2(F,APCDVSIT) ;EP; called by actions where type has to be selected

 NEW APCDMNE,APCDPAT,APCDCAT,APCDMODE,APCDTYPE,APCDLOC,APCDVLK,DIC,APCDDATE,APCDMODE

 D CLEAR^VALM1,FULL^VALM1

 W !!,"Adding ",$P(^DIC(F,0),U),!

 S Y=1 F  Q:Y<1  D

 . S DIC=F,DIC(0)="MQZ",X="??" D ^DIC

 . S DIC(0)="AEMQZ" D ^DIC Q:Y<1

 . S APCDMNE=$O(^APCDTKW("B",$P(Y,U,2),0)) Q:APCDMNE=""

 . S APCDMODE="A" D VINIT(APCDMNE),^APCDEA3 S Y=1

 D RESET Q

 ;

VINIT(M) ; -- initialize visit variables; M=mnemonic

 NEW APCDX

 D ENP^XBDIQ1(9000010,APCDVSIT,".01;.03;.05:.07;.08","APCDX(","I")

 S APCDDATE=APCDX(.01,"I"),APCDPAT=APCDX(.05,"I")

 S APCDTYPE=APCDX(.03,"I"),APCDVLK=APCDVSIT

 S APCDCAT=APCDX(.07,"I"),APCDLOC=APCDX(.06,"I"),APCDCLN=APCDX(.08,"I")

 S APCDOVRR="" ;need this for provider narrative lookup

 Q

 ;

 ;

MNE ;EP - called from protocol entry

 D FULL^VALM1

 S APCDPAT=DFN

 D EN^APCDEL

 D RESET

 Q

VSIT ;;

VPOV ;;

APCDEFL   ; IHS/CMI/LAB - EDIT VISIT LIST TEMP ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;; ;

 +3       ; -- PUBLIC ENTRY POINT to edit visit

 +4       ; -- calling routine must pass visit ien in APCDVSIT

 +5       ; -- calling routine responsible for killing APCDVSIT

 +6       ; -- calling routine responsible for killing APCD vars - D ^APCDEKL

 +7       ;

EN        ;PEP -- main entry point for APCDEF VISIT DISPLAY

 +1        NEW DFN,APCDPARM,APCDOVRR

 +2        KILL ^TMP("APCDEFG",$JOB)

 +3        IF '$GET(APCDVSIT)

               QUIT 

 +4        DO EP^APCDEFG(APCDVSIT)

 +5        SET DFN=$$VALI^XBDIQ1(9000010,APCDVSIT,.05)

 +6       ; pcc needs the AUPN variables set

           SET Y=DFN

           DO ^AUPNPAT

 +7        IF '$DATA(^APCDSITE(DUZ(2),0))

               WRITE !!,"The DATA ENTRY Site Parameters have not been",!,"established for this facility.  PLEASE NOTIFY YOUR SUPERVISOR!",$CHAR(7),$CHAR(7)

               DO DEFAULT^APCDVAR

               QUIT 

 +8        DO ^APCDEIN

 +9        DO EN^VALM("APCDEF VISIT DISPLAY")

 +10       DO CLEAR^VALM1

 +11       KILL ^TMP("APCDEFG",$JOB),APCDBROW,APCDOVRR

 +12       QUIT 

 +13      ;

EN1       ;EP - called from input templates

 +1        DO EN^XBNEW("EN^APCDEFL","APCDVSIT")

 +2        KILL Y

 +3        QUIT 

HDR       ; -- header code

 +1       ;S VALMHDR(1)="This is a test header for APCD VISIT DISPLAY."

 +2       ;S VALMHDR(2)="This is the second line"

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        SET VALMCNT=$ORDER(^TMP("APCDEFG",$JOB,"IDX"),-1)

 +2        SET VALMSG="-  Prev Screen     Q  Quit     ?? for More Actions"

 +3        QUIT 

 +4       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL AUPNVSIT,APCDNUM,VALMCNT,VALMSG

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

GETITEM   ; -- select item from list

 +1        KILL APCDDR

 +2        DO EN^VALM2(XQORNOD(0),"OS")

 +3        IF '$DATA(VALMY)

               WRITE !!,"No item selected!"

               QUIT 

 +4        SET APCDDR=$ORDER(VALMY(0))

 +5        DO CLEAR^VALM1

           DO FULL^VALM1

 +6        QUIT 

RESET     ;

 +1        KILL ^TMP("APCDEFG",$JOB)

 +2        SET VALMBCK="R"

           DO EP^APCDEFG(APCDVSIT)

           DO INIT

           QUIT 

 +3       ;

PAUSE     ;

 +1        NEW DIR

           SET DIR(0)="E"

           SET DIR("A")="Press ENTER to continue"

           DO ^DIR

           QUIT 

 +2       ;

EDIT      ;EP; called by edit/delete action

 +1        NEW APCDDR,APCDMNE,APCDPAT,APCDCAT,APCDTYPE,APCDLOC,APCDVLK,APCDDATE,APCDMODE,APCDCLN,APCDOVRR

 +2        DO GETITEM

           IF '$DATA(APCDDR)

               SET VALMBCK="R"

               WRITE !!,$CHAR(7),$CHAR(7),"That is not an editable item, please see your supervisor for assistance.",!

               HANG 3

               DO INIT

               QUIT 

 +3        SET APCDDR=$GET(^TMP("APCDEFG",$JOB,"MNE",APCDDR))

 +4        IF '$GET(APCDDR)

               SET VALMBCK="R"

               WRITE !!,$CHAR(7),$CHAR(7),"That is not an editable item, please see your supervisor for assistance.",!

               HANG 3

               DO INIT

               QUIT 

 +5        SET APCDMNE=APCDDR

           SET APCDMNE("NAME")=$PIECE(^APCDTKW(APCDDR,0),U)

 +6        SET APCDMODE="M"

           SET APCDVLK=APCDVSIT

           DO VINIT(APCDMNE)

 +7        DO ^APCDEA3

 +8        DO RESET

           QUIT 

 +9       ;

ADD(M,APCDVSIT) ;EP; called by actions to add v file entries

 +1        NEW APCDMNE,APCDPAT,APCDCAT,APCDTYPE,APCDLOC,APCDVLK,APCDDATE,APCDMODE

 +2        DO CLEAR^VALM1

           DO FULL^VALM1

 +3        SET APCDMNE=$ORDER(^APCDTKW("B",M,0))

           IF APCDMNE=""

               QUIT 

 +4        WRITE !!,"Adding ",$PIECE(^APCDTKW(APCDMNE,0),U,12),!!

 +5        SET APCDMODE="A"

           DO VINIT(APCDMNE)

 +6        DO ^APCDEA3

 +7        DO RESET

           QUIT 

 +8       ;

ADD2(F,APCDVSIT) ;EP; called by actions where type has to be selected

 +1        NEW APCDMNE,APCDPAT,APCDCAT,APCDMODE,APCDTYPE,APCDLOC,APCDVLK,DIC,APCDDATE,APCDMODE

 +2        DO CLEAR^VALM1

           DO FULL^VALM1

 +3        WRITE !!,"Adding ",$PIECE(^DIC(F,0),U),!

 +4        SET Y=1

           FOR 

               IF Y<1

                   QUIT 

               Begin DoDot:1

 +5                SET DIC=F

                   SET DIC(0)="MQZ"

                   SET X="??"

                   DO ^DIC

 +6                SET DIC(0)="AEMQZ"

                   DO ^DIC

                   IF Y<1

                       QUIT 

 +7                SET APCDMNE=$ORDER(^APCDTKW("B",$PIECE(Y,U,2),0))

                   IF APCDMNE=""

                       QUIT 

 +8                SET APCDMODE="A"

                   DO VINIT(APCDMNE)

                   DO ^APCDEA3

                   SET Y=1

               End DoDot:1

 +9        DO RESET

           QUIT 

 +10      ;

VINIT(M)  ; -- initialize visit variables; M=mnemonic

 +1        NEW APCDX

 +2        DO ENP^XBDIQ1(9000010,APCDVSIT,".01;.03;.05:.07;.08","APCDX(","I")

 +3        SET APCDDATE=APCDX(.01,"I")

           SET APCDPAT=APCDX(.05,"I")

 +4        SET APCDTYPE=APCDX(.03,"I")

           SET APCDVLK=APCDVSIT

 +5        SET APCDCAT=APCDX(.07,"I")

           SET APCDLOC=APCDX(.06,"I")

           SET APCDCLN=APCDX(.08,"I")

 +6       ;need this for provider narrative lookup

           SET APCDOVRR=""

 +7        QUIT 

 +8       ;

 +9       ;

MNE       ;EP - called from protocol entry

 +1        DO FULL^VALM1

 +2        SET APCDPAT=DFN

 +3        DO EN^APCDEL

 +4        DO RESET

 +5        QUIT 

VSIT      ;;

VPOV      ;;