VENPCC3.m

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      ;