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 ;;
