APCDHHF ; IHS/CMI/LAB - GET HISTORICAL VISIT DATE ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
ENHHF(PATDFN,TEXT,APCDTEMP,SRVCAT) ;
S APCDTDA=""
D EN^XBNEW("ENHHF1^APCDHHF","PATDFN;TEXT;APCDTEMP;APCDTDA;SRVCAT")
Q
ENHHF1 ;
S (APCDPAT,AUPNPAT)=PATDFN
S Y=AUPNPAT D ^AUPNPAT
S DIR(0)="D^::EP",DIR("A")="Enter Date of Historical "_TEXT KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"No date entered." Q
S APCDTX=Y
S:$E(APCDTX,6,7)="00" APCDTX=$E(APCDTX,1,5)_"01" S:$E(APCDTX,4,5)="00" APCDTX=$E(APCDTX,1,3)_"01"_$E(APCDTX,6,7) S:APCDTX'["." APCDTX=APCDTX_".12" ;Y2000
;end Y2K
S X=APCDTX
S APCDGHVD="",APCDTERR=0,APCDTMG1="Enter a Date betwen the Patient's DOB and Today.",APCDTMG2="Can be imprecise (e.g. 1975 or 3/1975 or 3/4/1975). Time optional."
X $P(^DD(9000010,.01,0),"^",5,99) I '$D(X) W !!,APCDTMG1,!,APCDTMG2,! S APCDTX="" G ENHHF1
S APCDVLDT=APCDTX,APCDLOOK=""
D ^APCDVLK
K APCDCLN
I APCDGHVD="^" S APCDTERR=1 G XIT
I APCDLOOK="" D CREATE I $G(APCDVSIT)="" G ENHHF1
S Y=PATDFN D ^AUPNPAT
;call DIE to update V File
S APCDPAT=PATDFN
S APCDOVRR=""
S DIE("NO^")=1
S (AUPNVSIT,DA)=APCDVSIT,DIE="^AUPNVSIT(",DR=APCDTEMP
S APCDDATE=$$VD^APCLV(APCDVSIT)
D ^DIE
D ^XBFMK
XIT ;
K Y,X,APCDVLDT,APCDTMG1,APCDTMG2,APCDGHVD
Q
CREATE ;
W !,"Creating PCC Visit...",!
S APCDVSIT=""
S Y=AUPNPAT D ^AUPNPAT
K APCDALVR
S APCDALVR("APCDPAT")=PATDFN
S APCDALVR("APCDDATE")=APCDTX
;get type of visit
K DIR
S DIR("B")=$P($G(^APCDSITE(DUZ(2),0)),U,17)
S DIR(0)="9000010,.03",DIR("A")="TYPE" D ^DIR K DIR
I $D(DIRUT) W !!,"Visit Type is required!" D ^XBFMK K APCDALVR Q
S APCDALVR("APCDTYPE")=Y
LOC ;get location and outside location
S APCDLOC=""
S DIC(0)="AEMQ",DIC="^AUTTLOC(" D ^DIC K DIC
I Y=-1 W !!,"Location is required. ^ NOT ALLOWED" G LOC
S APCDALVR("APCDLOC")=+Y
I $E($P(^AUTTLOC(+Y,0),U,10),5,6)<50 G CAT
I $P($G(^APCDSITE(DUZ(2),0)),U,16)'="Y" G CAT
S DIR(0)="9000010,2101",DIR("A")="Enter OUTSIDE Location" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S Y=""
I Y]"" S APCDALVR("APCDOLOC")=Y
CAT ;
S APCDALVR("APCDCAT")=$S($G(SRVCAT)]"":SRVCAT,1:"E")
S APCDALVR("APCDAUTO")="",APCDALVR("APCDADD")=""
D ^APCDALV
I $D(APCDALVR("APCDAFLG")) W !!,"creating visit failed" K APCDALVR D ^XBFMK Q
S APCDVSIT=APCDALVR("APCDVSIT")
Q
APCDHHF ; IHS/CMI/LAB - GET HISTORICAL VISIT DATE ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
ENHHF(PATDFN,TEXT,APCDTEMP,SRVCAT) ;
+1 SET APCDTDA=""
+2 DO EN^XBNEW("ENHHF1^APCDHHF","PATDFN;TEXT;APCDTEMP;APCDTDA;SRVCAT")
+3 QUIT
ENHHF1 ;
+1 SET (APCDPAT,AUPNPAT)=PATDFN
+2 SET Y=AUPNPAT
DO ^AUPNPAT
+3 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Date of Historical "_TEXT
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !!,"No date entered."
QUIT
+5 SET APCDTX=Y
+6 ;Y2000
IF $EXTRACT(APCDTX,6,7)="00"
SET APCDTX=$EXTRACT(APCDTX,1,5)_"01"
IF $EXTRACT(APCDTX,4,5)="00"
SET APCDTX=$EXTRACT(APCDTX,1,3)_"01"_$EXTRACT(APCDTX,6,7)
IF APCDTX'["."
SET APCDTX=APCDTX_".12"
+7 ;end Y2K
+8 SET X=APCDTX
+9 SET APCDGHVD=""
SET APCDTERR=0
SET APCDTMG1="Enter a Date betwen the Patient's DOB and Today."
SET APCDTMG2="Can be imprecise (e.g. 1975 or 3/1975 or 3/4/1975). Time optional."
+10 XECUTE $PIECE(^DD(9000010,.01,0),"^",5,99)
IF '$DATA(X)
WRITE !!,APCDTMG1,!,APCDTMG2,!
SET APCDTX=""
GOTO ENHHF1
+11 SET APCDVLDT=APCDTX
SET APCDLOOK=""
+12 DO ^APCDVLK
+13 KILL APCDCLN
+14 IF APCDGHVD="^"
SET APCDTERR=1
GOTO XIT
+15 IF APCDLOOK=""
DO CREATE
IF $GET(APCDVSIT)=""
GOTO ENHHF1
+16 SET Y=PATDFN
DO ^AUPNPAT
+17 ;call DIE to update V File
+18 SET APCDPAT=PATDFN
+19 SET APCDOVRR=""
+20 SET DIE("NO^")=1
+21 SET (AUPNVSIT,DA)=APCDVSIT
SET DIE="^AUPNVSIT("
SET DR=APCDTEMP
+22 SET APCDDATE=$$VD^APCLV(APCDVSIT)
+23 DO ^DIE
+24 DO ^XBFMK
XIT ;
+1 KILL Y,X,APCDVLDT,APCDTMG1,APCDTMG2,APCDGHVD
+2 QUIT
CREATE ;
+1 WRITE !,"Creating PCC Visit...",!
+2 SET APCDVSIT=""
+3 SET Y=AUPNPAT
DO ^AUPNPAT
+4 KILL APCDALVR
+5 SET APCDALVR("APCDPAT")=PATDFN
+6 SET APCDALVR("APCDDATE")=APCDTX
+7 ;get type of visit
+8 KILL DIR
+9 SET DIR("B")=$PIECE($GET(^APCDSITE(DUZ(2),0)),U,17)
+10 SET DIR(0)="9000010,.03"
SET DIR("A")="TYPE"
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
WRITE !!,"Visit Type is required!"
DO ^XBFMK
KILL APCDALVR
QUIT
+12 SET APCDALVR("APCDTYPE")=Y
LOC ;get location and outside location
+1 SET APCDLOC=""
+2 SET DIC(0)="AEMQ"
SET DIC="^AUTTLOC("
DO ^DIC
KILL DIC
+3 IF Y=-1
WRITE !!,"Location is required. ^ NOT ALLOWED"
GOTO LOC
+4 SET APCDALVR("APCDLOC")=+Y
+5 IF $EXTRACT($PIECE(^AUTTLOC(+Y,0),U,10),5,6)<50
GOTO CAT
+6 IF $PIECE($GET(^APCDSITE(DUZ(2),0)),U,16)'="Y"
GOTO CAT
+7 SET DIR(0)="9000010,2101"
SET DIR("A")="Enter OUTSIDE Location"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET Y=""
+9 IF Y]""
SET APCDALVR("APCDOLOC")=Y
CAT ;
+1 SET APCDALVR("APCDCAT")=$SELECT($GET(SRVCAT)]"":SRVCAT,1:"E")
+2 SET APCDALVR("APCDAUTO")=""
SET APCDALVR("APCDADD")=""
+3 DO ^APCDALV
+4 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,"creating visit failed"
KILL APCDALVR
DO ^XBFMK
QUIT
+5 SET APCDVSIT=APCDALVR("APCDVSIT")
+6 QUIT
