APCDATC ; IHS/CMI/TUCSON - POV LOOKUP ;
;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2
;
START ;
X:$D(^DD(9000010.33,.01,12.1)) ^DD(9000010.33,.01,12.1)
S DIC="^BCMTCF(",DIC(0)="AEMQ"
I $G(APCDCANI),$P($G(^BCMSITE(DUZ(2),0)),U,2)="C" S DIC("S")="I $P(^(0),U,5)=APCDCANI"
I $G(APCDCANI),$P($G(^BCMSITE(DUZ(2),0)),U,2)="D" S DIC("S")="I $P(^(0),U,9)=APCDCANI"
S DIC("A")="Enter TRANSACTION CODE: "
D ^DIC K DIC
G:Y="" XIT
I Y=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XIT
I Y=-1 S APCDTERR=1,APCDLOOK="" G XIT
S APCDLOOK="`"_+Y
XIT K Y,X,DO,D,DD,DIPGM
Q
;
CAN ;EP - called from APCD CTC and APCD CTE templates
I $P($G(^BCMSITE(DUZ(2),0)),U,2)="D" G DEPT
S DIC="^AUTTCAN(",DIC(0)="AEMQ"
S DIC("A")="Enter the CAN number you will be processing: "
D ^DIC K DIC
G:Y="" XITCAN
I Y=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XITCAN
I Y=-1 S APCDTERR=1,APCDLOOK="" G XITCAN
S APCDCANI=+Y
D XITCAN
Q
XITCAN K Y,X,DO,D,DD,DIPGM
Q
DEPT ;EP - called from APCD CTC and APCD CTE templates
S DIC="^BCMDEPT(",DIC(0)="AEMQ"
S DIC("A")="Enter the DEPARTMENT number you will be processing: "
D ^DIC K DIC
G:Y="" XITDEPT
I Y=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XITDEPT
I Y=-1 S APCDTERR=1,APCDLOOK="" G XITDEPT
S APCDCANI=+Y
D XITDEPT
Q
XITDEPT ;
K Y,X,DO,D,DD,DIPGM
Q
CTC ;
D EN^XBNEW("CTC1^APCDATC","APCDLOOK;APCDVSIT;APCDPAT;APCDTERR;APCDTT;AUPN*")
K APCDTT
K Y
Q
;
CTC1 ;
;get can
D CAN
I $G(APCDCANI)="" W !!,"No ",$S($$CAND(DUZ(2)):"CAN",1:"DEPARTMENT")," selected." Q
S APCDQ="" F D CTC2 Q:APCDQ
Q
;
CTC2 ;
X:$D(^DD(9000010.33,.01,12.1)) ^DD(9000010.33,.01,12.1)
S DIC="^BCMTCF(",DIC(0)="AEMQ"
I $G(APCDCANI) D
.I $$CAND(DUZ(2)) S DIC("S")="I $P(^(0),U,5)=APCDCANI" Q
.I '$$CAND(DUZ(2)) S DIC("S")="I $P(^(0),U,9)=APCDCANI"
S DIC("A")="Enter TRANSACTION CODE: "
D ^DIC K DIC
I Y=-1,X=""!(X="^") S APCDQ=1 Q
I Y=-1 S APCDQ=1,APCDLOOK="" Q
S APCDLOOK="`"_+Y
S DIC="^AUPNVTC(",DIADD=1,DLAYGO=9000010.33,X=APCDLOOK,DIC(0)="L",DIC("DR")=".02////"_APCDPAT_";.03////"_APCDVSIT_";1216////"_$$NOW^XLFDT K DO,D0,DD D ^DIC K DIADD,DLAYGO
I Y=-1 W !!,"adding V transaction failed..." D ^XBFMK Q
S DA=+Y
S DIE="^AUPNVTC(",DR="[APCD TC EDIT]" D ^DIE K DIE,DA,DR
CTCXIT ;
K Y,X,DO,D,DD,DIPGM
Q
;
CAND(D) ;
I $P($G(^BCMSITE(DUZ(2),0)),U,2)="D" Q 0
Q 1
APCDATC ; IHS/CMI/TUCSON - POV LOOKUP ;
+1 ;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2
+2 ;
START ;
+1 IF $DATA(^DD(9000010.33,.01,12.1))
XECUTE ^DD(9000010.33,.01,12.1)
+2 SET DIC="^BCMTCF("
SET DIC(0)="AEMQ"
+3 IF $GET(APCDCANI)
IF $PIECE($GET(^BCMSITE(DUZ(2),0)),U,2)="C"
SET DIC("S")="I $P(^(0),U,5)=APCDCANI"
+4 IF $GET(APCDCANI)
IF $PIECE($GET(^BCMSITE(DUZ(2),0)),U,2)="D"
SET DIC("S")="I $P(^(0),U,9)=APCDCANI"
+5 SET DIC("A")="Enter TRANSACTION CODE: "
+6 DO ^DIC
KILL DIC
+7 IF Y=""
GOTO XIT
+8 IF Y=-1
IF X=""!(X="^")
SET APCDTSKI=1
SET APCDLOOK=""
GOTO XIT
+9 IF Y=-1
SET APCDTERR=1
SET APCDLOOK=""
GOTO XIT
+10 SET APCDLOOK="`"_+Y
XIT KILL Y,X,DO,D,DD,DIPGM
+1 QUIT
+2 ;
CAN ;EP - called from APCD CTC and APCD CTE templates
+1 IF $PIECE($GET(^BCMSITE(DUZ(2),0)),U,2)="D"
GOTO DEPT
+2 SET DIC="^AUTTCAN("
SET DIC(0)="AEMQ"
+3 SET DIC("A")="Enter the CAN number you will be processing: "
+4 DO ^DIC
KILL DIC
+5 IF Y=""
GOTO XITCAN
+6 IF Y=-1
IF X=""!(X="^")
SET APCDTSKI=1
SET APCDLOOK=""
GOTO XITCAN
+7 IF Y=-1
SET APCDTERR=1
SET APCDLOOK=""
GOTO XITCAN
+8 SET APCDCANI=+Y
+9 DO XITCAN
+10 QUIT
XITCAN KILL Y,X,DO,D,DD,DIPGM
+1 QUIT
DEPT ;EP - called from APCD CTC and APCD CTE templates
+1 SET DIC="^BCMDEPT("
SET DIC(0)="AEMQ"
+2 SET DIC("A")="Enter the DEPARTMENT number you will be processing: "
+3 DO ^DIC
KILL DIC
+4 IF Y=""
GOTO XITDEPT
+5 IF Y=-1
IF X=""!(X="^")
SET APCDTSKI=1
SET APCDLOOK=""
GOTO XITDEPT
+6 IF Y=-1
SET APCDTERR=1
SET APCDLOOK=""
GOTO XITDEPT
+7 SET APCDCANI=+Y
+8 DO XITDEPT
+9 QUIT
XITDEPT ;
+1 KILL Y,X,DO,D,DD,DIPGM
+2 QUIT
CTC ;
+1 DO EN^XBNEW("CTC1^APCDATC","APCDLOOK;APCDVSIT;APCDPAT;APCDTERR;APCDTT;AUPN*")
+2 KILL APCDTT
+3 KILL Y
+4 QUIT
+5 ;
CTC1 ;
+1 ;get can
+2 DO CAN
+3 IF $GET(APCDCANI)=""
WRITE !!,"No ",$SELECT($$CAND(DUZ(2)):"CAN",1:"DEPARTMENT")," selected."
QUIT
+4 SET APCDQ=""
FOR
DO CTC2
IF APCDQ
QUIT
+5 QUIT
+6 ;
CTC2 ;
+1 IF $DATA(^DD(9000010.33,.01,12.1))
XECUTE ^DD(9000010.33,.01,12.1)
+2 SET DIC="^BCMTCF("
SET DIC(0)="AEMQ"
+3 IF $GET(APCDCANI)
Begin DoDot:1
+4 IF $$CAND(DUZ(2))
SET DIC("S")="I $P(^(0),U,5)=APCDCANI"
QUIT
+5 IF '$$CAND(DUZ(2))
SET DIC("S")="I $P(^(0),U,9)=APCDCANI"
End DoDot:1
+6 SET DIC("A")="Enter TRANSACTION CODE: "
+7 DO ^DIC
KILL DIC
+8 IF Y=-1
IF X=""!(X="^")
SET APCDQ=1
QUIT
+9 IF Y=-1
SET APCDQ=1
SET APCDLOOK=""
QUIT
+10 SET APCDLOOK="`"_+Y
+11 SET DIC="^AUPNVTC("
SET DIADD=1
SET DLAYGO=9000010.33
SET X=APCDLOOK
SET DIC(0)="L"
SET DIC("DR")=".02////"_APCDPAT_";.03////"_APCDVSIT_";1216////"_$$NOW^XLFDT
KILL DO,D0,DD
DO ^DIC
KILL DIADD,DLAYGO
+12 IF Y=-1
WRITE !!,"adding V transaction failed..."
DO ^XBFMK
QUIT
+13 SET DA=+Y
+14 SET DIE="^AUPNVTC("
SET DR="[APCD TC EDIT]"
DO ^DIE
KILL DIE,DA,DR
CTCXIT ;
+1 KILL Y,X,DO,D,DD,DIPGM
+2 QUIT
+3 ;
CAND(D) ;
+1 IF $PIECE($GET(^BCMSITE(DUZ(2),0)),U,2)="D"
QUIT 0
+2 QUIT 1
