VENPCC3 ; IHS/OIT/GIS - CHECK-IN UTILITIES ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
CK ; EP-CHECK TO BE SURE THE SYSTEM IS RUNNING PROPERLY
I $L($T(UMSG^VENPCCP2)) Q ; NEW ERROR MESSAGE PROCESS IN PLACE
N EIEN,%,X,DIE,DR,DA,DIC,D,DI,DQ,D0,ERROR
S EIEN=$O(^VEN(7.7,99999999),-1) I 'EIEN Q
S X=$P($G(^VEN(7.7,EIEN,0)),U,6) I X Q
S ERROR=$G(^VEN(7.7,EIEN,1))
I ERROR["out of paper",$G(IO)'=$P($G(^VEN(7.7,EIEN,0)),U,5) Q
W !!,*7,"ENCOUNTER FORM ERROR DETECTED!!!"
W !,"""",ERROR,""""
W !,"PLEASE TAKE APPROPRIATE ACTION",!!
S DIE="^VEN(7.7,",DA=EIEN,DR=".06////1"
L +^VEN(7.7):0 I $T D ^DIE L -^VEN(7.7)
Q
;
VISIT(APCDPAT,APCDDATE,APCDLOC,APCDCLN) ; EP-CREATE NEW VISIT, RETURN VISIT IEN
NEW %,APCDADD,APCDCAT,APCDDOB,APCDDOD,APCDSEX,APCDDFLT,APCDFLC,APCDFVOK,APCDVSIT,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AUPNVSIT,DI,DFLN,DIG,DIH,DISYS,DIU,DIV,DIW,DQ,DICR,DK,DL,%Q,APCDTYPE
I '$D(^AUPNPAT(+$G(APCDPAT),0)) Q "MISSING OR INVALID PATIENT DFN"
S %=+$G(APCDDATE) I %'?7N,%'?7N1"."1.4N Q "MISSING OF INVALID VISIT DATE"
S %=+$G(APCDLOC) I '$D(^AUTTLOC(%,0)) Q "MISSING OR INVALID LOCATION"
S APCDTYPE=$P($G(^APCCCTRL(+$G(DUZ(2)),0)),U,4) I APCDTYPE="" Q "MISSING OR INVALID VISIT TYPE"
S %=+$G(APCDCLN) I '$D(^DIC(40.7,%,0)) Q "MISSING OR INVALID CLINIC TYPE"
S APCDADD="",APCDFVOK=""
S %=$P($G(^DIC(40.7,+$G(CLINIC),0)),U) S APCDCAT=$S(%["TELEPHONE":"T",%["CHART REVIEW":"C",1:"A")
D ^APCDALV
I $G(APCDFLG) Q "NO VISIT CREATED - FAILED FILEMAN AUDITS"
Q $G(APCDVSIT)
;
CLEAN(OLD,START) ; EP-CLEAN OUT ALL VISITS IN A TIME RANGE WITH NO DEC
NEW %DT,D0,DA,DIC,DIE,DR,VDATE,VPRV,X,Y
I $G(OLD)="" S X="T-7",%DT="TX" D ^%DT S OLD=Y
I $G(START)="" S X="T-90",%DT="TX" D ^%DT S START=Y
S DIE="^AUPNVSIT(",DR=".11////1"
S VDATE=START F S VDATE=$O(^AUPNVSIT("B",VDATE)) Q:'VDATE Q:VDATE>OLD S DA=0 F S DA=$O(^AUPNVSIT("B",VDATE,DA)) Q:'DA D
. S X=$G(^AUPNVSIT(DA,0)) I '$L(X) Q
. I $P(X,U,11) Q ; VISIT ALREADY DELETED
. I $P(X,U,9) Q ; DONT DELETE IF THERE IS A DEC
. L +^AUPNVSIT(DA):0 I $T D ^DIE L -^AUPNVSIT(DA)
. W "."
. Q
Q
;
VCN(VIEN,DEPTIEN) ; EP-GIVEN THE VISIT IEN (VIEN) AND DEPT IEN RETURN THE VCN
N %
I '$D(^AUPNVSIT(+$G(VIEN),0)) Q "MISSING OR INVALID VISIT CONTROL NUMBER"
I '$D(^VEN(7.95,+$G(DEPTIEN),0)) Q "MISSING OR INVALID DEPT IEN"
NEW CNT,D,D0,DA,DFN,DI,DIC,DIE,DQ,DR,HRN,J,REC,SERVCAT,VCNT,VRN,X
S %=$P($G(^AUPNVSIT(VIEN,11)),U,3) I %'="" Q % ; VCN ALREADY EXISTS
S REC=^AUPNVSIT(VIEN,0)
S DFN=$P(REC,U,5) I '$D(^DPT(+$G(DFN),0)) Q "MISSING OR INVALID DFN"
S SERVCAT=$P(REC,U,7) I SERVCAT="" Q "MISSING SERVICE CATEGORY"
S HRN=$$CHART^VENPCC1A(DEPTIEN,DFN) I 'HRN Q "UNABLE TO FIND HRN"
S CNT=0 F J=0:0 S J=$O(^AUPNVSIT("AC",DFN,J)) Q:'J S CNT=CNT+1
F VCNT=CNT:1 S VRN=HRN_"."_VCNT_SERVCAT I '$D(^AUPNVSIT("VCN",VRN)) Q
S DIE="^AUPNVSIT(",DA=VIEN,DR="1103////^S X=VRN"
L +^AUPNVSIT(VIEN):5 E Q "UNABLE TO UPDATE THE VISIT FILE"
D ^DIE L -^AUPNVSIT(DA)
Q VRN_U_VIEN
;
OB(DFN) ; EP - CLOSE PREGNANCY LOOP IF NECESSARY
N CPIEN,BDFN,DD,EDD,EDDT,DT60,X,Y,Z,DIC,DIE,DA,DR,%,TDT,OBIEN
S CPIEN=$O(^AUPNCPG("B",DFN,999999999),-1) I 'CPIEN Q
S DD=$P($G(^AUPNCPG(CPIEN,131)),U,1) I DD Q
S EDD=$P($G(^AUPNCPG(CPIEN,101)),U,1) I 'EDD Q
S DT60=$$FMADD^XLFDT(EDD,+60) I 'DT60 Q
I DT<DT60 Q ; THIS DIALOG ONLY OCCURS IF THE PATIENT IS 60 DAYS POST EDD AND NO DD HAS BEEN RECORDED
EDDT S EDDT=$$FMTE^XLFDT(EDD,2)
ASK W !,"The record indicates that this patient was followed here for prenatal care"
W !,"and the Estimated Date of Delivery (EDD) was : ",EDDT
S DIR(0)="SO^Y:YES;N:NO;U:UNKNOWN",DIR("A")="Did the pregnancy result in a delivery" D ^DIR K DIR
I Y="Y" G DEL
I Y'="N" D ^XBFMK Q
TERM ; PREG ENDED WITHOUT A DELIVERY
S DIR(0)="DO^::EP",DIR("A")="When did the pregnancy end"
S DIR("?")="If you don't know the exact date, enter an approximate date." D ^DIR K DIR
PDT ; PROCESS THE DATE
I Y'?7N D ^XBFMK Q
S TDT=Y,DIE=9000051,DA=CPIEN,DR="131.01////^S X=TDT"
L +^AUPNCPG(DA):1 I D ^DIE L -^AUPNCPG(DA)
S OBIEN=$O(^AUPNOBHX("B",DFN,0)) I 'OBIEN D ^XBFMK Q
I $D(^AUPNOBHX(OBIEN,103,"B",TDT)) Q
S DA(1)=OBIEN,DIC="^AUPNOBHX("_DA(1)_",103,",DLAYGO=9000050.103,DIC(0)="L",DIC("P")=9000050.103
S X=TDT
D ^DIC
D ^XBFMK
Q
;
DEL ; GET DELIVERY INFO
N NAME,SEX,BIEN,DOB
W !,"Is the chlid from this delivery registered here"
S %=0 D YN^DICN I %'=1 D Q
. S DIR(0)="DO^::EP",DIR("A")="What was the delivery date"
. D ^DIR K DIR I Y'?7N Q
. D PDT ; PROCESS THE DATE
. D ^XBFMK
. Q
KID S DIC=2,DIC(0)="AEQM",DIC("A")="Name or chart # of child"
D ^DIC I Y=-1 D ^XBFMK Q
S BIEN=+Y,NAME=$P(Y,U,2),SEX=$P($G(^DPT(BIEN,0)),U,2),DOB=$P($G(^DPT(BIEN,0)),U,3)
S %=0 W !,"Are you certian this is the correct child"
D YN^DICN I %'=1 G KID
S TDT=DOB D PDT
S DIC("P")=9000051.135,DA(1)=CPIEN,DIC="^AUPNCPG("_DA(1)_",135,",DIC(0)="L",X=NAME
D ^DIC I Y=-1 D ^XBFMK Q
S DA=+Y,DIE=DIC,DR=".04////^S X=SEX;.11////^S X=BIEN"
L +^AUPNCPG(CPIEN,DA(1),135):1 I D ^DIE L -^AUPNCPG(CPIEN,DA(1),135)
D ^XBFMK
Q
;
VENPCC3 ; IHS/OIT/GIS - CHECK-IN UTILITIES ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
CK ; EP-CHECK TO BE SURE THE SYSTEM IS RUNNING PROPERLY
+1 ; NEW ERROR MESSAGE PROCESS IN PLACE
IF $LENGTH($TEXT(UMSG^VENPCCP2))
QUIT
+2 NEW EIEN,%,X,DIE,DR,DA,DIC,D,DI,DQ,D0,ERROR
+3 SET EIEN=$ORDER(^VEN(7.7,99999999),-1)
IF 'EIEN
QUIT
+4 SET X=$PIECE($GET(^VEN(7.7,EIEN,0)),U,6)
IF X
QUIT
+5 SET ERROR=$GET(^VEN(7.7,EIEN,1))
+6 IF ERROR["out of paper"
IF $GET(IO)'=$PIECE($GET(^VEN(7.7,EIEN,0)),U,5)
QUIT
+7 WRITE !!,*7,"ENCOUNTER FORM ERROR DETECTED!!!"
+8 WRITE !,"""",ERROR,""""
+9 WRITE !,"PLEASE TAKE APPROPRIATE ACTION",!!
+10 SET DIE="^VEN(7.7,"
SET DA=EIEN
SET DR=".06////1"
+11 LOCK +^VEN(7.7):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.7)
+12 QUIT
+13 ;
VISIT(APCDPAT,APCDDATE,APCDLOC,APCDCLN) ; EP-CREATE NEW VISIT, RETURN VISIT IEN
+1 NEW %,APCDADD,APCDCAT,APCDDOB,APCDDOD,APCDSEX,APCDDFLT,APCDFLC,APCDFVOK,APCDVSIT,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AUPNVSIT,DI,DFLN,DIG,DIH,DISYS,DIU,DIV,DIW,DQ,DICR,DK,DL,%Q,APCDTYPE
+2 IF '$DATA(^AUPNPAT(+$GET(APCDPAT),0))
QUIT "MISSING OR INVALID PATIENT DFN"
+3 SET %=+$GET(APCDDATE)
IF %'?7N
IF %'?7N1"."1.4N
QUIT "MISSING OF INVALID VISIT DATE"
+4 SET %=+$GET(APCDLOC)
IF '$DATA(^AUTTLOC(%,0))
QUIT "MISSING OR INVALID LOCATION"
+5 SET APCDTYPE=$PIECE($GET(^APCCCTRL(+$GET(DUZ(2)),0)),U,4)
IF APCDTYPE=""
QUIT "MISSING OR INVALID VISIT TYPE"
+6 SET %=+$GET(APCDCLN)
IF '$DATA(^DIC(40.7,%,0))
QUIT "MISSING OR INVALID CLINIC TYPE"
+7 SET APCDADD=""
SET APCDFVOK=""
+8 SET %=$PIECE($GET(^DIC(40.7,+$GET(CLINIC),0)),U)
SET APCDCAT=$SELECT(%["TELEPHONE":"T",%["CHART REVIEW":"C",1:"A")
+9 DO ^APCDALV
+10 IF $GET(APCDFLG)
QUIT "NO VISIT CREATED - FAILED FILEMAN AUDITS"
+11 QUIT $GET(APCDVSIT)
+12 ;
CLEAN(OLD,START) ; EP-CLEAN OUT ALL VISITS IN A TIME RANGE WITH NO DEC
+1 NEW %DT,D0,DA,DIC,DIE,DR,VDATE,VPRV,X,Y
+2 IF $GET(OLD)=""
SET X="T-7"
SET %DT="TX"
DO ^%DT
SET OLD=Y
+3 IF $GET(START)=""
SET X="T-90"
SET %DT="TX"
DO ^%DT
SET START=Y
+4 SET DIE="^AUPNVSIT("
SET DR=".11////1"
+5 SET VDATE=START
FOR
SET VDATE=$ORDER(^AUPNVSIT("B",VDATE))
IF 'VDATE
QUIT
IF VDATE>OLD
QUIT
SET DA=0
FOR
SET DA=$ORDER(^AUPNVSIT("B",VDATE,DA))
IF 'DA
QUIT
Begin DoDot:1
+6 SET X=$GET(^AUPNVSIT(DA,0))
IF '$LENGTH(X)
QUIT
+7 ; VISIT ALREADY DELETED
IF $PIECE(X,U,11)
QUIT
+8 ; DONT DELETE IF THERE IS A DEC
IF $PIECE(X,U,9)
QUIT
+9 LOCK +^AUPNVSIT(DA):0
IF $TEST
DO ^DIE
LOCK -^AUPNVSIT(DA)
+10 WRITE "."
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
VCN(VIEN,DEPTIEN) ; EP-GIVEN THE VISIT IEN (VIEN) AND DEPT IEN RETURN THE VCN
+1 NEW %
+2 IF '$DATA(^AUPNVSIT(+$GET(VIEN),0))
QUIT "MISSING OR INVALID VISIT CONTROL NUMBER"
+3 IF '$DATA(^VEN(7.95,+$GET(DEPTIEN),0))
QUIT "MISSING OR INVALID DEPT IEN"
+4 NEW CNT,D,D0,DA,DFN,DI,DIC,DIE,DQ,DR,HRN,J,REC,SERVCAT,VCNT,VRN,X
+5 ; VCN ALREADY EXISTS
SET %=$PIECE($GET(^AUPNVSIT(VIEN,11)),U,3)
IF %'=""
QUIT %
+6 SET REC=^AUPNVSIT(VIEN,0)
+7 SET DFN=$PIECE(REC,U,5)
IF '$DATA(^DPT(+$GET(DFN),0))
QUIT "MISSING OR INVALID DFN"
+8 SET SERVCAT=$PIECE(REC,U,7)
IF SERVCAT=""
QUIT "MISSING SERVICE CATEGORY"
+9 SET HRN=$$CHART^VENPCC1A(DEPTIEN,DFN)
IF 'HRN
QUIT "UNABLE TO FIND HRN"
+10 SET CNT=0
FOR J=0:0
SET J=$ORDER(^AUPNVSIT("AC",DFN,J))
IF 'J
QUIT
SET CNT=CNT+1
+11 FOR VCNT=CNT:1
SET VRN=HRN_"."_VCNT_SERVCAT
IF '$DATA(^AUPNVSIT("VCN",VRN))
QUIT
+12 SET DIE="^AUPNVSIT("
SET DA=VIEN
SET DR="1103////^S X=VRN"
+13 LOCK +^AUPNVSIT(VIEN):5
IF '$TEST
QUIT "UNABLE TO UPDATE THE VISIT FILE"
+14 DO ^DIE
LOCK -^AUPNVSIT(DA)
+15 QUIT VRN_U_VIEN
+16 ;
OB(DFN) ; EP - CLOSE PREGNANCY LOOP IF NECESSARY
+1 NEW CPIEN,BDFN,DD,EDD,EDDT,DT60,X,Y,Z,DIC,DIE,DA,DR,%,TDT,OBIEN
+2 SET CPIEN=$ORDER(^AUPNCPG("B",DFN,999999999),-1)
IF 'CPIEN
QUIT
+3 SET DD=$PIECE($GET(^AUPNCPG(CPIEN,131)),U,1)
IF DD
QUIT
+4 SET EDD=$PIECE($GET(^AUPNCPG(CPIEN,101)),U,1)
IF 'EDD
QUIT
+5 SET DT60=$$FMADD^XLFDT(EDD,+60)
IF 'DT60
QUIT
+6 ; THIS DIALOG ONLY OCCURS IF THE PATIENT IS 60 DAYS POST EDD AND NO DD HAS BEEN RECORDED
IF DT<DT60
QUIT
EDDT SET EDDT=$$FMTE^XLFDT(EDD,2)
ASK WRITE !,"The record indicates that this patient was followed here for prenatal care"
+1 WRITE !,"and the Estimated Date of Delivery (EDD) was : ",EDDT
+2 SET DIR(0)="SO^Y:YES;N:NO;U:UNKNOWN"
SET DIR("A")="Did the pregnancy result in a delivery"
DO ^DIR
KILL DIR
+3 IF Y="Y"
GOTO DEL
+4 IF Y'="N"
DO ^XBFMK
QUIT
TERM ; PREG ENDED WITHOUT A DELIVERY
+1 SET DIR(0)="DO^::EP"
SET DIR("A")="When did the pregnancy end"
+2 SET DIR("?")="If you don't know the exact date, enter an approximate date."
DO ^DIR
KILL DIR
PDT ; PROCESS THE DATE
+1 IF Y'?7N
DO ^XBFMK
QUIT
+2 SET TDT=Y
SET DIE=9000051
SET DA=CPIEN
SET DR="131.01////^S X=TDT"
+3 LOCK +^AUPNCPG(DA):1
IF $TEST
DO ^DIE
LOCK -^AUPNCPG(DA)
+4 SET OBIEN=$ORDER(^AUPNOBHX("B",DFN,0))
IF 'OBIEN
DO ^XBFMK
QUIT
+5 IF $DATA(^AUPNOBHX(OBIEN,103,"B",TDT))
QUIT
+6 SET DA(1)=OBIEN
SET DIC="^AUPNOBHX("_DA(1)_",103,"
SET DLAYGO=9000050.103
SET DIC(0)="L"
SET DIC("P")=9000050.103
+7 SET X=TDT
+8 DO ^DIC
+9 DO ^XBFMK
+10 QUIT
+11 ;
DEL ; GET DELIVERY INFO
+1 NEW NAME,SEX,BIEN,DOB
+2 WRITE !,"Is the chlid from this delivery registered here"
+3 SET %=0
DO YN^DICN
IF %'=1
Begin DoDot:1
+4 SET DIR(0)="DO^::EP"
SET DIR("A")="What was the delivery date"
+5 DO ^DIR
KILL DIR
IF Y'?7N
QUIT
+6 ; PROCESS THE DATE
DO PDT
+7 DO ^XBFMK
+8 QUIT
End DoDot:1
QUIT
KID SET DIC=2
SET DIC(0)="AEQM"
SET DIC("A")="Name or chart # of child"
+1 DO ^DIC
IF Y=-1
DO ^XBFMK
QUIT
+2 SET BIEN=+Y
SET NAME=$PIECE(Y,U,2)
SET SEX=$PIECE($GET(^DPT(BIEN,0)),U,2)
SET DOB=$PIECE($GET(^DPT(BIEN,0)),U,3)
+3 SET %=0
WRITE !,"Are you certian this is the correct child"
+4 DO YN^DICN
IF %'=1
GOTO KID
+5 SET TDT=DOB
DO PDT
+6 SET DIC("P")=9000051.135
SET DA(1)=CPIEN
SET DIC="^AUPNCPG("_DA(1)_",135,"
SET DIC(0)="L"
SET X=NAME
+7 DO ^DIC
IF Y=-1
DO ^XBFMK
QUIT
+8 SET DA=+Y
SET DIE=DIC
SET DR=".04////^S X=SEX;.11////^S X=BIEN"
+9 LOCK +^AUPNCPG(CPIEN,DA(1),135):1
IF $TEST
DO ^DIE
LOCK -^AUPNCPG(CPIEN,DA(1),135)
+10 DO ^XBFMK
+11 QUIT
+12 ;
