- 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
