ADGCALLS.m

ADGCALLS ; IHS/ADC/PDW/ENM - PCC LINK ; [ 06/05/2002  1:14 PM ]

 ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1010,1011**;MAR 25, 1999

 ;

 ;cmi/anch/maw 10/20/2008 PATCH 1010 added set of APCDALV("APCDOPT") to BDG VISIT CREATOR

 ;cmi/anch/maw 05/05/2009 PATCH 1010 add check at visit delete to see if BDG VISIT CREATOR is in visit before deletion

 ;

APCDEIN ;EP; -- initialize PCC variables

 D ^APCDEIN Q

 ;

DSCV ;EP; -- day surgery create visit

 N BDGOPT

 S BDGOPT="BDG VISIT CREATOR"

 S APCDALVR("APCDOPT")=$O(^DIC(19,"B",BDGOPT,0))  ;cmi/maw 10/20/2008 PATCH 1011 added set of option used to create visit

 D ^APCDALV I $D(APCDALVR("APCDAFLG")) D ERR,APCDEKL Q

 D APCDEKL Q

 ;

APCDALV ;EP; -- create visit

 ;cmi/maw 9/2/2009 PATCH 1010

 N BDGOPT

 S BDGOPT="BDG VISIT CREATOR"

 S APCDALVR("APCDOPT")=$O(^DIC(19,"B",BDGOPT,0))  ;cmi/maw 10/20/2008 PATCH 1010 added set of option used to create visit

 S APCDALVR("APCDADD")=1,APCDALVR("APCDPAT")=DFN

 S APCDALVR("APCDLOC")=DUZ(2),APCDALVR("APCDCAT")="H"

 S APCDALVR("APCDTYPE")=$P(^DG(43,1,9999999),U)

 S APCDALVR("APCDDATE")=+DGPMA

 D ^APCDALV I $D(APCDALVR("APCDAFLG")) D ERR,APCDEKL Q

 W !!,"Visit created for date of admission" S DIE="^DGPM("

 L +^DGPM(DGPMCA):3 I '$T D  Q

 . W !,*7,"CANNOT UPDATE VISIT LINK; ENTRY LOCKED"

 . D APCDEKL

 S DA=DGPMCA,DR="9999999.1////"_APCDALVR("APCDVSIT")

 D ^DIE L -^DGPM(DGPMCA)

 D APCDEKL Q

 ;

APCDCVDT ;EP; -- edit visit date

 I '+$$VIP D APCDALV Q

 S APCDCVDT("VISIT DFN")=$$VIP,APCDCVDT("VISIT DATE/TIME")=+DGPMA

 D ^APCDCVDT I $D(APCDCVDT("ERROR FLAG")) D ERR

 D APCDEKL Q

 ;

APCDVDLT ;EP; -- delete visit

 ;cmi/maw 5/5/2009 PATCH 1010 check here to see if BDG VISIT CREATOR and delete only if

 D APCDEIN S APCDVDLT=$$VIP D ^APCDVDLT,APCDEKL Q

 ;

APCDALVR ;EP; -- v hospitalization

 D APCDEIN

 ; -- check/create visit

 I '+$$VIC N DGPMA,DGPMDA,DGPMP S DGPMA=^DGPM(DGPMCA,0),DGPMDA=DGPMCA D APCDALV

 I '+$$VIC D ERR,APCDEKL Q

 S APCDALVR("APCDVSIT")=+$$VIC

 ; -- create v hosp

 I '$O(^AUPNVINP("AD",+$$VIC,0)) D CVH Q

 ;I $P(DGPMA,U,2)=3&(DGPMP="") D CVH Q

 ; -- modify v hosp

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (MOD)]"

 S APCDALVR("APCDLOOK")=$O(^AUPNVINP("AD",+$$VIC,0))

 S APCDALVR("APCDDSCH")=+^DGPM(+$P(^DGPM(DGPMCA,0),U,17),0)

 D ^APCDALVR I $D(APCDALVR("APCDAFLG")) D ERR

 D APCDEKL Q

 ;

CVH ; -- create v hosp

 S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDTDT")="`"_$P(DGPMA,U,4)

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (ADD)]"

 S:$P(DGPMA,U,18)=10 APCDALVR("APCDTTT")=$$TFAC

 S APCDALVR("APCDLOOK")=$E(+DGPMA,1,12),APCDALVR("APCDTDCS")="`"_$$DSRV

 S APCDALVR("APCDTADS")="`"_$P(^DGPM($O(^DGPM("APHY",DGPMCA,0)),0),U,9)

 S APCDALVR("APCDTAT")="`"_$P(^DGPM(DGPMCA,0),U,4)

 D ^APCDALVR I $D(APCDALVR("APCDAFLG")) D ERR

 D APCDEKL Q

 ;

APCDEA3 ;EP;***> call to PCC Data Entry rtns

 D ^APCDEA3 Q

 ;

APCDCHK ;EP;***> call to PCC visit check rtn

 D ^APCDVCHK Q

 ;

APCLYV3 ;EP;***> call to pcc reports rtns

 D ^APCLYV31,^APCLYV32 Q   ;clinic visits with icd codes

 ;

APCDEKL ;EP; -- cleanup variables

 D EN1^APCDEKL K DIE,DA,DR,APCDALVR,APCDCVDT,APCDVDLT  Q

 ;

ERR ; -- error processor

 Q

 ;

TFAC() ;EP; -- transfer facility

 N X S X=$P(DGPMA,U,5) Q $S(X["DIC(4":"VA/IHS.`",1:"VENDOR.`")_+X

 ;

DSRV() ;EP; -- discharge service

 N X,Y S Y=9999999.9999999-$G(^DGPM(+$P(^DGPM(DGPMCA,0),U,17),0)) Q:'Y 0

 S X=$O(^DGPM("ATID6",+DFN,+$O(^DGPM("ATID6",+DFN,Y)),0))

 Q $P($G(^DGPM(+X,0)),U,9)

 ;

VIP() ; -- visit ien (dgpmp)

 Q +$O(^AUPNVSIT("AA",+DFN,+$$IDP,0))

 ;

IDP() ; -- inverse date (dgpmp)

 Q (9999999-$P(+DGPMP,"."))_"."_$P(+DGPMP,".",2)

 ;

VIC() ; -- visit ien (dgpmca)

 N X,Y S (X,Y)=0

 F  S X=$O(^AUPNVSIT("AA",+DFN,+$$IDC,X)) Q:'X  Q:Y  D

 . I $P($G(^AUPNVSIT(X,0)),U,7)="H" S Y=X

 Q Y

 ;

 ;Q +$O(^AUPNVSIT("AA",+DFN,+$$IDC,0))

 ;

IDC() ; -- inverse date (dgpmca)

 Q (9999999-$P(+^DGPM(+DGPMCA,0),"."))_"."_$P(+^DGPM(+DGPMCA,0),".",2)

ADGCALLS  ; IHS/ADC/PDW/ENM - PCC LINK ; [ 06/05/2002  1:14 PM ]

 +1       ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1010,1011**;MAR 25, 1999

 +2       ;

 +3       ;cmi/anch/maw 10/20/2008 PATCH 1010 added set of APCDALV("APCDOPT") to BDG VISIT CREATOR

 +4       ;cmi/anch/maw 05/05/2009 PATCH 1010 add check at visit delete to see if BDG VISIT CREATOR is in visit before deletion

 +5       ;

APCDEIN   ;EP; -- initialize PCC variables

 +1        DO ^APCDEIN

           QUIT 

 +2       ;

DSCV      ;EP; -- day surgery create visit

 +1        NEW BDGOPT

 +2        SET BDGOPT="BDG VISIT CREATOR"

 +3       ;cmi/maw 10/20/2008 PATCH 1011 added set of option used to create visit

           SET APCDALVR("APCDOPT")=$ORDER(^DIC(19,"B",BDGOPT,0))

 +4        DO ^APCDALV

           IF $DATA(APCDALVR("APCDAFLG"))

               DO ERR

               DO APCDEKL

               QUIT 

 +5        DO APCDEKL

           QUIT 

 +6       ;

APCDALV   ;EP; -- create visit

 +1       ;cmi/maw 9/2/2009 PATCH 1010

 +2        NEW BDGOPT

 +3        SET BDGOPT="BDG VISIT CREATOR"

 +4       ;cmi/maw 10/20/2008 PATCH 1010 added set of option used to create visit

           SET APCDALVR("APCDOPT")=$ORDER(^DIC(19,"B",BDGOPT,0))

 +5        SET APCDALVR("APCDADD")=1

           SET APCDALVR("APCDPAT")=DFN

 +6        SET APCDALVR("APCDLOC")=DUZ(2)

           SET APCDALVR("APCDCAT")="H"

 +7        SET APCDALVR("APCDTYPE")=$PIECE(^DG(43,1,9999999),U)

 +8        SET APCDALVR("APCDDATE")=+DGPMA

 +9        DO ^APCDALV

           IF $DATA(APCDALVR("APCDAFLG"))

               DO ERR

               DO APCDEKL

               QUIT 

 +10       WRITE !!,"Visit created for date of admission"

           SET DIE="^DGPM("

 +11       LOCK +^DGPM(DGPMCA):3

           IF '$TEST

               Begin DoDot:1

 +12               WRITE !,*7,"CANNOT UPDATE VISIT LINK; ENTRY LOCKED"

 +13               DO APCDEKL

               End DoDot:1

               QUIT 

 +14       SET DA=DGPMCA

           SET DR="9999999.1////"_APCDALVR("APCDVSIT")

 +15       DO ^DIE

           LOCK -^DGPM(DGPMCA)

 +16       DO APCDEKL

           QUIT 

 +17      ;

APCDCVDT  ;EP; -- edit visit date

 +1        IF '+$$VIP

               DO APCDALV

               QUIT 

 +2        SET APCDCVDT("VISIT DFN")=$$VIP

           SET APCDCVDT("VISIT DATE/TIME")=+DGPMA

 +3        DO ^APCDCVDT

           IF $DATA(APCDCVDT("ERROR FLAG"))

               DO ERR

 +4        DO APCDEKL

           QUIT 

 +5       ;

APCDVDLT  ;EP; -- delete visit

 +1       ;cmi/maw 5/5/2009 PATCH 1010 check here to see if BDG VISIT CREATOR and delete only if

 +2        DO APCDEIN

           SET APCDVDLT=$$VIP

           DO ^APCDVDLT

           DO APCDEKL

           QUIT 

 +3       ;

APCDALVR  ;EP; -- v hospitalization

 +1        DO APCDEIN

 +2       ; -- check/create visit

 +3        IF '+$$VIC

               NEW DGPMA,DGPMDA,DGPMP

               SET DGPMA=^DGPM(DGPMCA,0)

               SET DGPMDA=DGPMCA

               DO APCDALV

 +4        IF '+$$VIC

               DO ERR

               DO APCDEKL

               QUIT 

 +5        SET APCDALVR("APCDVSIT")=+$$VIC

 +6       ; -- create v hosp

 +7        IF '$ORDER(^AUPNVINP("AD",+$$VIC,0))

               DO CVH

               QUIT 

 +8       ;I $P(DGPMA,U,2)=3&(DGPMP="") D CVH Q

 +9       ; -- modify v hosp

 +10       SET APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (MOD)]"

 +11       SET APCDALVR("APCDLOOK")=$ORDER(^AUPNVINP("AD",+$$VIC,0))

 +12       SET APCDALVR("APCDDSCH")=+^DGPM(+$PIECE(^DGPM(DGPMCA,0),U,17),0)

 +13       DO ^APCDALVR

           IF $DATA(APCDALVR("APCDAFLG"))

               DO ERR

 +14       DO APCDEKL

           QUIT 

 +15      ;

CVH       ; -- create v hosp

 +1        SET APCDALVR("APCDPAT")=DFN

           SET APCDALVR("APCDTDT")="`"_$PIECE(DGPMA,U,4)

 +2        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (ADD)]"

 +3        IF $PIECE(DGPMA,U,18)=10

               SET APCDALVR("APCDTTT")=$$TFAC

 +4        SET APCDALVR("APCDLOOK")=$EXTRACT(+DGPMA,1,12)

           SET APCDALVR("APCDTDCS")="`"_$$DSRV

 +5        SET APCDALVR("APCDTADS")="`"_$PIECE(^DGPM($ORDER(^DGPM("APHY",DGPMCA,0)),0),U,9)

 +6        SET APCDALVR("APCDTAT")="`"_$PIECE(^DGPM(DGPMCA,0),U,4)

 +7        DO ^APCDALVR

           IF $DATA(APCDALVR("APCDAFLG"))

               DO ERR

 +8        DO APCDEKL

           QUIT 

 +9       ;

APCDEA3   ;EP;***> call to PCC Data Entry rtns

 +1        DO ^APCDEA3

           QUIT 

 +2       ;

APCDCHK   ;EP;***> call to PCC visit check rtn

 +1        DO ^APCDVCHK

           QUIT 

 +2       ;

APCLYV3   ;EP;***> call to pcc reports rtns

 +1       ;clinic visits with icd codes

           DO ^APCLYV31

           DO ^APCLYV32

           QUIT 

 +2       ;

APCDEKL   ;EP; -- cleanup variables

 +1        DO EN1^APCDEKL

           KILL DIE,DA,DR,APCDALVR,APCDCVDT,APCDVDLT

           QUIT 

 +2       ;

ERR       ; -- error processor

 +1        QUIT 

 +2       ;

TFAC()    ;EP; -- transfer facility

 +1        NEW X

           SET X=$PIECE(DGPMA,U,5)

           QUIT $SELECT(X["DIC(4":"VA/IHS.`",1:"VENDOR.`")_+X

 +2       ;

DSRV()    ;EP; -- discharge service

 +1        NEW X,Y

           SET Y=9999999.9999999-$GET(^DGPM(+$PIECE(^DGPM(DGPMCA,0),U,17),0))

           IF 'Y

               QUIT 0

 +2        SET X=$ORDER(^DGPM("ATID6",+DFN,+$ORDER(^DGPM("ATID6",+DFN,Y)),0))

 +3        QUIT $PIECE($GET(^DGPM(+X,0)),U,9)

 +4       ;

VIP()     ; -- visit ien (dgpmp)

 +1        QUIT +$ORDER(^AUPNVSIT("AA",+DFN,+$$IDP,0))

 +2       ;

IDP()     ; -- inverse date (dgpmp)

 +1        QUIT (9999999-$PIECE(+DGPMP,"."))_"."_$PIECE(+DGPMP,".",2)

 +2       ;

VIC()     ; -- visit ien (dgpmca)

 +1        NEW X,Y

           SET (X,Y)=0

 +2        FOR 

               SET X=$ORDER(^AUPNVSIT("AA",+DFN,+$$IDC,X))

               IF 'X

                   QUIT 

               IF Y

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^AUPNVSIT(X,0)),U,7)="H"

                       SET Y=X

               End DoDot:1

 +4        QUIT Y

 +5       ;

 +6       ;Q +$O(^AUPNVSIT("AA",+DFN,+$$IDC,0))

 +7       ;

IDC()     ; -- inverse date (dgpmca)

 +1        QUIT (9999999-$PIECE(+^DGPM(+DGPMCA,0),"."))_"."_$PIECE(+^DGPM(+DGPMCA,0),".",2)