APCDALV1 ; IHS/CMI/LAB - VISIT CREATION CONT. ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;IHS/CMI/LAB - added display of VCN if it exists
;
INIT ;EP;INITIALIZATION/EDIT INPUT VARIABLES
K APCDAFLG,APCDALVR("APCDAFLG"),APCDVSIT("NEW"),APCDALVR("APCDVSIT","NEW")
I $D(APCDALVR)\10 S APCDAX="" F APCDAL=0:0 S APCDAX=$O(APCDALVR(APCDAX)) Q:APCDAX="" S @APCDAX=APCDALVR(APCDAX)
S U="^",APCDVSIT=""
S:$D(ZTQUEUED) APCDAUTO="" ; default to auto mode if in background
D EDIT
Q:$D(APCDAFLG)
Q
;
EDIT ; EDIT PASSED VARIABLES
I $D(APCDADF),APCDADF=+APCDADF,APCDADF>0,APCDADF<4
E K APCDADF ; kill it if it isn't right
S:$P(APCDDATE,".",2)="" APCDDATE=+APCDDATE_".12"
S APCDDATE=$E(APCDDATE,1,12)
S:'$D(APCDTYPE) APCDTYPE="I"
I APCDTYPE="" S APCDAFLG=3,APCDAFLG("ERR")=".03^"_APCDTYPE_"^TYPE OF VISIT MISSING" Q
S:'$D(APCDCAT) APCDCAT="A"
S:APCDCAT="" APCDCAT="A"
S:$E(APCDPAT)="`" APCDPAT=$E(APCDPAT,2,99)
I '$D(^AUPNPAT(APCDPAT,0)) S APCDAFLG=3,APCDAFLG("ERR")=".05^"_APCDPAT_"^PATIENT NOT IN AUPNPAT GLOBAL" Q
S:$E(APCDLOC)="`" APCDLOC=$E(APCDLOC,2,99)
I '$D(^AUTTLOC(APCDLOC,0)) S APCDAFLG=3,APCDAFLG("ERR")=".06^"_APCDLOC_"^LOCATION PTR NOT IN AUTTLOC" Q
I $D(APCDOLOC),APCDOLOC?.E1C.E S APCDAFLG=3,APCDAFLG("ERR")="2101^"_APCDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
I $G(APCDOLOC)]"",$L(APCDOLOC)<2!($L(APCDOLOC)>50) S APCDAFLG=3,APCDAFLG("ERR")="2101^"_APCDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
I $D(APCDCLN),APCDCLN="" K APCDCLN Q
Q:'$D(APCDCLN)
S:$E(APCDCLN)="`" APCDCLN=$E(APCDCLN,2,99)
I APCDCLN?1N.N,'$D(^DIC(40.7,APCDCLN,0)) S APCDAFLG=3,APCDAFLG("ERR")=".08^"_APCDCLN_"^CLINIC NOT VALID" Q
I APCDCLN'?1N.N S X=APCDCLN,DIC="^DIC(40.7,",DIC(0)="M" D ^DIC S:+Y>0 APCDCLN=+Y
I APCDCLN'?1N.N S APCDAFLG=3,APCDAFLG("ERR")=".08^"_APCDCLN_"^CLINIC NOT VALID" Q
I $D(APCDTBP) S X="`"_APCDTBP I '$D(X) S APCDAFLG=3,APCDAFLG("ERR")=".04^"_APCDTPB_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX" Q
12 ;
I $D(APCDPVL),'$D(^AUPNVSIT(APCDPVL))!($P($G(^AUPNVSIT(APCDPVL,0)),U,11)) S APCDAFLG=3,APCDAFLG("ERR")=".12^"_APCDPVL_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR" Q
16 ;
I $G(APCDAPPT)]"" S %=$$EXTSET^XBFUNC(9000010,.16,APCDAPPT) I %="" S APCDAFLG=3,APCDAFLG("ERR")=".16^"_APCDAPPT_"^WALKIN / APPT FAILED INPUT TX" Q
17 ;
I $G(APCDEVM)]"",'APCDEVM S APCDAFLG=3,APCDAFLG("ERR")=".17^"_APCDEVM_"^EVAL&MAN NOT VALID INTERNAL FORMAT" Q
I $G(APCDEVM) S %=$P($G(^DD(9000010,.17,12.1)),"=",2) S X=$$FIND1^APCDDIC(81,APCDEVM,"I",%) I 'X S APCDAFLG=3,APCDAFLG("ERR")=".17^"_APCDEVM_"^EVAL&MAN FAILED INPUT TX" Q
18 ;
I $G(APCDCODT)]"" S X=$$FMTE^XLFDT(APCDCODT) X $P(^DD(9000010,.18,0),U,5,99) I '$D(X) S APCDAFLG=3,APCDAFLG("ERR")=".18^"_APCDCODT_"^CHECK OUT DATE/TIME FAILED INPUT TX" Q
19 ;
I $G(APCDLS)]"" S %=$$EXTSET^XBFUNC(9000010,.19,APCDLS) I %="" S APCDAFLG=3,APCDAFLG("ERR")=".19^"_APCDLS_"^LEVEL OF SERVICE FAILED INPUT TX" Q
21 ;
I $G(APCDVELG)]"",'APCDVELG S APCDAFLG=3,APCDAFLG("ERR")=".21^"_APCDVELG_"^VA ELIG NOT VALID INTERNAL FORMAT" Q
I $G(APCDVELG) S %=$P($G(^DD(9000010,.21,12.1)),"=",2) S X=$$FIND1^APCDDIC(8,APCDVELG,"I",%) I 'X S APCDAFLG=3,APCDAFLG("ERR")=".21^"_APCDVELG_"^VA ELIG FAILED INPUT TX" Q
22 ;
I $G(APCDHL)]"",'APCDHL S APCDAFLG=3,APCDAFLG("ERR")=".22^"_APCDHL_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT" Q
I $G(APCDHL) S %=$P($G(^DD(9000010,.22,12.1)),"=",2) S X=$$FIND1^APCDDIC(44,APCDHL,"I",%) I 'X S APCDAFLG=3,APCDAFLG("ERR")=".22^"_APCDHL_"^HOSPITAL LOCATION FAILED INPUT TX" Q
24 ;
I $G(APCDOPT)]"",'APCDOPT S APCDAFLG=3,APCDAFLG("ERR")=".24^"_APCDOPT_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT" Q
I $G(APCDOPT) S %=$P($G(^DD(9000010,.24,12.1)),"=",2) S X=$$FIND1^APCDDIC(19,APCDOPT,"I",%) I 'X S APCDAFLG=3,APCDAFLG("ERR")=".24^"_APCDOPT_"^OPTION USED TO CREATE FAILED INPUT TX" Q
Q
25 ;
I $G(APCDPROT)]"",'APCDPROT S APCDAFLG=3,APCDAFLG("ERR")=".25^"_APCDPROT_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT" Q
I $G(APCDPROT) S %=$P($G(^DD(9000010,.25,12.1)),"=",2) S X=$$FIND1^APCDDIC(101,APCDPROT,"I",%) I 'X S APCDAFLG=3,APCDAFLG("ERR")=".25^"_APCDPROT_"^PROTOCOL USED TO CREATE FAILED INPUT TX" Q
26 ;
I $G(APCDAPDT)]"" S X=$$FMTE^XLFDT(APCDAPDT) X $P(^DD(9000010,.26,0),U,5,99) I '$D(X) S APCDAFLG=3,APCDAFLG("ERR")=".26^"_APCDAPDT_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT" Q
Q
;
;--------------------------------------------------------------
;
OPTION ;EP;GET OPTION FROM USER
F APCDAL=0:0 D OPTION2 Q:APCDAO
Q
;
OPTION2 ; LET USER SELECT OPTION
W !!,"PATIENT: ",$P(^DPT(APCDPAT,0),U)," has VISITs, same date, location.",!
W !,"1 Create New VISIT"
W !,"2 Exit without selecting VISIT"
W !,"3 Display one of the existing VISITs"
I $D(^XUSEC("APCDZVMRG",DUZ)),'$D(APCDALV(4)) W !,"4 Merge two VISITS"
W !!,"Or select one of the following existing VISITs:",!
F APCDAI=0:0 S APCDAI=$O(APCDALV(APCDAI)) Q:APCDAI="" S APCDAX=APCDALV(APCDAI) D WRITE
S DIR(0)="N^1:"_APCDAC_":0",DIR("A")="Choose one",DIR("?")="Choose one of the numbers listed above" S:$D(APCDADF) DIR("B")=APCDADF D ^DIR K DIR
I $D(DIRUT) S APCDAO=2 Q
S Y=+Y
I Y=3 D DISPLAY Q
I Y<($S('$D(APCDALV(4)):5,1:4)) S APCDAO=Y Q
S APCDAO=Y,APCDVSIT=APCDALV(Y)
Q
;
WRITE ; WRITE VISITS FOR SELECT
S APCDA11=$G(^AUPNVSIT(APCDAX,11)),APCDAX=^AUPNVSIT(APCDAX,0)
S APCDAT=$P(+APCDAX,".",2),APCDAT=$S(APCDAT="":"<NONE>",$L(APCDAT)=1:APCDAT_"0:00 ",1:$E(APCDAT,1,2)_":"_$E(APCDAT,3,4)_$E("00",1,2-$L($E(APCDAT,3,4)))_" ")
W !,APCDAI," TIME: ",APCDAT,"TYPE: ",$P(APCDAX,U,3)," CATEGORY: ",$P(APCDAX,U,7)," CLINIC: ",$S($P(APCDAX,U,8)]"":$E($P(^DIC(40.7,$P(APCDAX,U,8),0),U),1,10),1:"<NONE>"),?56,"DEC: ",$S($P(APCDAX,U,9):$P(APCDAX,U,9),1:0)
I $P(APCDA11,U,3)]"" W ?64,"VCN: ",$P(APCDA11,U,3)
I $P(APCDAX,U,22) W !?3,"Hospital Location: ",$P($G(^SC($P(APCDAX,U,22),0)),U)
K APCDAT
Q
;
DISPLAY ; DISPLAY VISIT FOR USER
I APCDAC=4 S APCDVDSP=APCDALV(APCDAC),APCDVDSP("NO IOF")="" D ^APCDVDSP Q
S DIR(0)="NO^"_$S('$D(APCDALV(4)):5,1:4)_":"_APCDAC_":0",DIR("A")="Which one",DIR("?")="Enter the number associated with the visit you wish to display" D ^DIR K DIR
Q:$D(DIRUT)
S APCDVDSP=APCDALV(+Y),APCDVDSP("NO IOF")="" D ^APCDVDSP
Q
;
MRG ;EP - merge two visits together
W ! S DIR(0)="NO^"_$S('$D(APCDALV(4)):5,1:4)_":"_APCDAC_":0",DIR("A")="Choose 'FROM' Visit",DIR("?")="Enter the number associated with the visit you wish to merge from (the one to be deleted)" D ^DIR K DIR
Q:$D(DIRUT)
S APCDVMF=APCDALV(+Y)
W ! S DIR(0)="NO^"_$S('$D(APCDALV(4)):5,1:4)_":"_APCDAC_":0",DIR("A")="Choose 'TO' Visit",DIR("?")="Enter the number associated with the visit you wish to merge into (the one to keep)" D ^DIR K DIR
Q:$D(DIRUT)
S APCDVMT=APCDALV(+Y)
I APCDVMF=APCDVMT W !!,$C(7),$C(7),"'From' and 'To' the same. Try Again!" Q
W !!,"******* FROM VISIT *******" S APCDVDSP=APCDVMF,APCDVDSP("NO IOF")="" D ^APCDVDSP
D PAUSE
W !!,"******* TO VISIT *******" S APCDVDSP=APCDVMT,APCDVDSP("NO IOF")="" D ^APCDVDSP
NEW APCDCAT,APCDCLN,APCDDATE,APCDDOB,APCDDOD,APCDLOC,APCDPAT,APCDSEX,APCDTYPE,APCDVSIT,APCDVMX,APCDVV,AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOB,AUPNVSIT,AUPNDOD
D EN1^APCDVMRG
Q
PAUSE ;EP
Q:$E(IOST)'="C"!(IO'=IO(0))
S DIR(0)="EO",DIR("A")="Press return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
APCDALV1 ; IHS/CMI/LAB - VISIT CREATION CONT. ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;IHS/CMI/LAB - added display of VCN if it exists
+3 ;
INIT ;EP;INITIALIZATION/EDIT INPUT VARIABLES
+1 KILL APCDAFLG,APCDALVR("APCDAFLG"),APCDVSIT("NEW"),APCDALVR("APCDVSIT","NEW")
+2 IF $DATA(APCDALVR)\10
SET APCDAX=""
FOR APCDAL=0:0
SET APCDAX=$ORDER(APCDALVR(APCDAX))
IF APCDAX=""
QUIT
SET @APCDAX=APCDALVR(APCDAX)
+3 SET U="^"
SET APCDVSIT=""
+4 ; default to auto mode if in background
IF $DATA(ZTQUEUED)
SET APCDAUTO=""
+5 DO EDIT
+6 IF $DATA(APCDAFLG)
QUIT
+7 QUIT
+8 ;
EDIT ; EDIT PASSED VARIABLES
+1 IF $DATA(APCDADF)
IF APCDADF=+APCDADF
IF APCDADF>0
IF APCDADF<4
+2 ; kill it if it isn't right
IF '$TEST
KILL APCDADF
+3 IF $PIECE(APCDDATE,".",2)=""
SET APCDDATE=+APCDDATE_".12"
+4 SET APCDDATE=$EXTRACT(APCDDATE,1,12)
+5 IF '$DATA(APCDTYPE)
SET APCDTYPE="I"
+6 IF APCDTYPE=""
SET APCDAFLG=3
SET APCDAFLG("ERR")=".03^"_APCDTYPE_"^TYPE OF VISIT MISSING"
QUIT
+7 IF '$DATA(APCDCAT)
SET APCDCAT="A"
+8 IF APCDCAT=""
SET APCDCAT="A"
+9 IF $EXTRACT(APCDPAT)="`"
SET APCDPAT=$EXTRACT(APCDPAT,2,99)
+10 IF '$DATA(^AUPNPAT(APCDPAT,0))
SET APCDAFLG=3
SET APCDAFLG("ERR")=".05^"_APCDPAT_"^PATIENT NOT IN AUPNPAT GLOBAL"
QUIT
+11 IF $EXTRACT(APCDLOC)="`"
SET APCDLOC=$EXTRACT(APCDLOC,2,99)
+12 IF '$DATA(^AUTTLOC(APCDLOC,0))
SET APCDAFLG=3
SET APCDAFLG("ERR")=".06^"_APCDLOC_"^LOCATION PTR NOT IN AUTTLOC"
QUIT
+13 IF $DATA(APCDOLOC)
IF APCDOLOC?.E1C.E
SET APCDAFLG=3
SET APCDAFLG("ERR")="2101^"_APCDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX"
QUIT
+14 IF $GET(APCDOLOC)]""
IF $LENGTH(APCDOLOC)<2!($LENGTH(APCDOLOC)>50)
SET APCDAFLG=3
SET APCDAFLG("ERR")="2101^"_APCDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX"
QUIT
+15 IF $DATA(APCDCLN)
IF APCDCLN=""
KILL APCDCLN
QUIT
+16 IF '$DATA(APCDCLN)
QUIT
+17 IF $EXTRACT(APCDCLN)="`"
SET APCDCLN=$EXTRACT(APCDCLN,2,99)
+18 IF APCDCLN?1N.N
IF '$DATA(^DIC(40.7,APCDCLN,0))
SET APCDAFLG=3
SET APCDAFLG("ERR")=".08^"_APCDCLN_"^CLINIC NOT VALID"
QUIT
+19 IF APCDCLN'?1N.N
SET X=APCDCLN
SET DIC="^DIC(40.7,"
SET DIC(0)="M"
DO ^DIC
IF +Y>0
SET APCDCLN=+Y
+20 IF APCDCLN'?1N.N
SET APCDAFLG=3
SET APCDAFLG("ERR")=".08^"_APCDCLN_"^CLINIC NOT VALID"
QUIT
+21 IF $DATA(APCDTBP)
SET X="`"_APCDTBP
IF '$DATA(X)
SET APCDAFLG=3
SET APCDAFLG("ERR")=".04^"_APCDTPB_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX"
QUIT
12 ;
+1 IF $DATA(APCDPVL)
IF '$DATA(^AUPNVSIT(APCDPVL))!($PIECE($GET(^AUPNVSIT(APCDPVL,0)),U,11))
SET APCDAFLG=3
SET APCDAFLG("ERR")=".12^"_APCDPVL_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR"
QUIT
16 ;
+1 IF $GET(APCDAPPT)]""
SET %=$$EXTSET^XBFUNC(9000010,.16,APCDAPPT)
IF %=""
SET APCDAFLG=3
SET APCDAFLG("ERR")=".16^"_APCDAPPT_"^WALKIN / APPT FAILED INPUT TX"
QUIT
17 ;
+1 IF $GET(APCDEVM)]""
IF 'APCDEVM
SET APCDAFLG=3
SET APCDAFLG("ERR")=".17^"_APCDEVM_"^EVAL&MAN NOT VALID INTERNAL FORMAT"
QUIT
+2 IF $GET(APCDEVM)
SET %=$PIECE($GET(^DD(9000010,.17,12.1)),"=",2)
SET X=$$FIND1^APCDDIC(81,APCDEVM,"I",%)
IF 'X
SET APCDAFLG=3
SET APCDAFLG("ERR")=".17^"_APCDEVM_"^EVAL&MAN FAILED INPUT TX"
QUIT
18 ;
+1 IF $GET(APCDCODT)]""
SET X=$$FMTE^XLFDT(APCDCODT)
XECUTE $PIECE(^DD(9000010,.18,0),U,5,99)
IF '$DATA(X)
SET APCDAFLG=3
SET APCDAFLG("ERR")=".18^"_APCDCODT_"^CHECK OUT DATE/TIME FAILED INPUT TX"
QUIT
19 ;
+1 IF $GET(APCDLS)]""
SET %=$$EXTSET^XBFUNC(9000010,.19,APCDLS)
IF %=""
SET APCDAFLG=3
SET APCDAFLG("ERR")=".19^"_APCDLS_"^LEVEL OF SERVICE FAILED INPUT TX"
QUIT
21 ;
+1 IF $GET(APCDVELG)]""
IF 'APCDVELG
SET APCDAFLG=3
SET APCDAFLG("ERR")=".21^"_APCDVELG_"^VA ELIG NOT VALID INTERNAL FORMAT"
QUIT
+2 IF $GET(APCDVELG)
SET %=$PIECE($GET(^DD(9000010,.21,12.1)),"=",2)
SET X=$$FIND1^APCDDIC(8,APCDVELG,"I",%)
IF 'X
SET APCDAFLG=3
SET APCDAFLG("ERR")=".21^"_APCDVELG_"^VA ELIG FAILED INPUT TX"
QUIT
22 ;
+1 IF $GET(APCDHL)]""
IF 'APCDHL
SET APCDAFLG=3
SET APCDAFLG("ERR")=".22^"_APCDHL_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT"
QUIT
+2 IF $GET(APCDHL)
SET %=$PIECE($GET(^DD(9000010,.22,12.1)),"=",2)
SET X=$$FIND1^APCDDIC(44,APCDHL,"I",%)
IF 'X
SET APCDAFLG=3
SET APCDAFLG("ERR")=".22^"_APCDHL_"^HOSPITAL LOCATION FAILED INPUT TX"
QUIT
24 ;
+1 IF $GET(APCDOPT)]""
IF 'APCDOPT
SET APCDAFLG=3
SET APCDAFLG("ERR")=".24^"_APCDOPT_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT"
QUIT
+2 IF $GET(APCDOPT)
SET %=$PIECE($GET(^DD(9000010,.24,12.1)),"=",2)
SET X=$$FIND1^APCDDIC(19,APCDOPT,"I",%)
IF 'X
SET APCDAFLG=3
SET APCDAFLG("ERR")=".24^"_APCDOPT_"^OPTION USED TO CREATE FAILED INPUT TX"
QUIT
+3 QUIT
25 ;
+1 IF $GET(APCDPROT)]""
IF 'APCDPROT
SET APCDAFLG=3
SET APCDAFLG("ERR")=".25^"_APCDPROT_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT"
QUIT
+2 IF $GET(APCDPROT)
SET %=$PIECE($GET(^DD(9000010,.25,12.1)),"=",2)
SET X=$$FIND1^APCDDIC(101,APCDPROT,"I",%)
IF 'X
SET APCDAFLG=3
SET APCDAFLG("ERR")=".25^"_APCDPROT_"^PROTOCOL USED TO CREATE FAILED INPUT TX"
QUIT
26 ;
+1 IF $GET(APCDAPDT)]""
SET X=$$FMTE^XLFDT(APCDAPDT)
XECUTE $PIECE(^DD(9000010,.26,0),U,5,99)
IF '$DATA(X)
SET APCDAFLG=3
SET APCDAFLG("ERR")=".26^"_APCDAPDT_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT"
QUIT
+2 QUIT
+3 ;
+4 ;--------------------------------------------------------------
+5 ;
OPTION ;EP;GET OPTION FROM USER
+1 FOR APCDAL=0:0
DO OPTION2
IF APCDAO
QUIT
+2 QUIT
+3 ;
OPTION2 ; LET USER SELECT OPTION
+1 WRITE !!,"PATIENT: ",$PIECE(^DPT(APCDPAT,0),U)," has VISITs, same date, location.",!
+2 WRITE !,"1 Create New VISIT"
+3 WRITE !,"2 Exit without selecting VISIT"
+4 WRITE !,"3 Display one of the existing VISITs"
+5 IF $DATA(^XUSEC("APCDZVMRG",DUZ))
IF '$DATA(APCDALV(4))
WRITE !,"4 Merge two VISITS"
+6 WRITE !!,"Or select one of the following existing VISITs:",!
+7 FOR APCDAI=0:0
SET APCDAI=$ORDER(APCDALV(APCDAI))
IF APCDAI=""
QUIT
SET APCDAX=APCDALV(APCDAI)
DO WRITE
+8 SET DIR(0)="N^1:"_APCDAC_":0"
SET DIR("A")="Choose one"
SET DIR("?")="Choose one of the numbers listed above"
IF $DATA(APCDADF)
SET DIR("B")=APCDADF
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
SET APCDAO=2
QUIT
+10 SET Y=+Y
+11 IF Y=3
DO DISPLAY
QUIT
+12 IF Y<($SELECT('$DATA(APCDALV(4)):5,1:4))
SET APCDAO=Y
QUIT
+13 SET APCDAO=Y
SET APCDVSIT=APCDALV(Y)
+14 QUIT
+15 ;
WRITE ; WRITE VISITS FOR SELECT
+1 SET APCDA11=$GET(^AUPNVSIT(APCDAX,11))
SET APCDAX=^AUPNVSIT(APCDAX,0)
+2 SET APCDAT=$PIECE(+APCDAX,".",2)
SET APCDAT=$SELECT(APCDAT="":"<NONE>",$LENGTH(APCDAT)=1:APCDAT_"0:00 ",1:$EXTRACT(APCDAT,1,2)_":"_$EXTRACT(APCDAT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(APCDAT,3,4)))_" ")
+3 WRITE !,APCDAI," TIME: ",APCDAT,"TYPE: ",$PIECE(APCDAX,U,3)," CATEGORY: ",$PIECE(APCDAX,U,7)," CLINIC: ",$SELECT($PIECE(APCDAX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,...
... $PIECE(APCDAX,U,8),0),U),1,10),1:"<NONE>"),?56,"DEC: ",$SELECT($PIECE(APCDAX,U,9):$PIECE(APCDAX,U,9),1:0)
+4 IF $PIECE(APCDA11,U,3)]""
WRITE ?64,"VCN: ",$PIECE(APCDA11,U,3)
+5 IF $PIECE(APCDAX,U,22)
WRITE !?3,"Hospital Location: ",$PIECE($GET(^SC($PIECE(APCDAX,U,22),0)),U)
+6 KILL APCDAT
+7 QUIT
+8 ;
DISPLAY ; DISPLAY VISIT FOR USER
+1 IF APCDAC=4
SET APCDVDSP=APCDALV(APCDAC)
SET APCDVDSP("NO IOF")=""
DO ^APCDVDSP
QUIT
+2 SET DIR(0)="NO^"_$SELECT('$DATA(APCDALV(4)):5,1:4)_":"_APCDAC_":0"
SET DIR("A")="Which one"
SET DIR("?")="Enter the number associated with the visit you wish to display"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET APCDVDSP=APCDALV(+Y)
SET APCDVDSP("NO IOF")=""
DO ^APCDVDSP
+5 QUIT
+6 ;
MRG ;EP - merge two visits together
+1 WRITE !
SET DIR(0)="NO^"_$SELECT('$DATA(APCDALV(4)):5,1:4)_":"_APCDAC_":0"
SET DIR("A")="Choose 'FROM' Visit"
SET DIR("?")="Enter the number associated with the visit you wish to merge from (the one to be deleted)"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 SET APCDVMF=APCDALV(+Y)
+4 WRITE !
SET DIR(0)="NO^"_$SELECT('$DATA(APCDALV(4)):5,1:4)_":"_APCDAC_":0"
SET DIR("A")="Choose 'TO' Visit"
SET DIR("?")="Enter the number associated with the visit you wish to merge into (the one to keep)"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET APCDVMT=APCDALV(+Y)
+7 IF APCDVMF=APCDVMT
WRITE !!,$CHAR(7),$CHAR(7),"'From' and 'To' the same. Try Again!"
QUIT
+8 WRITE !!,"******* FROM VISIT *******"
SET APCDVDSP=APCDVMF
SET APCDVDSP("NO IOF")=""
DO ^APCDVDSP
+9 DO PAUSE
+10 WRITE !!,"******* TO VISIT *******"
SET APCDVDSP=APCDVMT
SET APCDVDSP("NO IOF")=""
DO ^APCDVDSP
+11 NEW APCDCAT,APCDCLN,APCDDATE,APCDDOB,APCDDOD,APCDLOC,APCDPAT,APCDSEX,APCDTYPE,APCDVSIT,APCDVMX,APCDVV,AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOB,AUPNVSIT,AUPNDOD
+12 DO EN1^APCDVMRG
+13 QUIT
PAUSE ;EP
+1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 SET DIR(0)="EO"
SET DIR("A")="Press return to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
