- 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
