- 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
