- BDMTRANS ; cmi/anch/maw - CONTROL TRANSFER OF PATIENTS TO CMS ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
- ;UTILITY TO TRANSFER CLIENTS FROM PCC REGISTERS, TAXONOMIES AND
- ;SEARCH TEMPLATES TO THE CMS
- ;;EP;ENTRY POINT
- EN I '$G(BDMRDA) D REG^BDMFUTIL
- Q:'$G(BDMRDA)
- D PCC:'$D(BDMQUIT)
- EXIT K BDMRG,BDMRGNA,BDMU,BDMTRN,BDMTRNA,BDMTRNX,BDMRGTP,BDMX,BDMI,BDMSLCT
- K BDMQUIT,BDM1,BDM2,BDM3,BDMGLB,BDMGLB1
- Q
- ;
- PCC D TLOOK
- Q:Y<1
- S BDMRG=BDMRDA
- S BDMSTAT="A",BDMSTAT(0)="ACTIVE"
- W !!?10,"The following transfer has been selected:",!!?10,"From SEARCH TEMPLATE: "
- W ?30,BDMTRNA,!?12,"To CMS register:",?30,BDMREGNM,!?10,"Transfer Status: ",?30,BDMSTAT," - ",BDMSTAT(0),!!,?10,"Is that what you want"
- S %=2 D YN^DICN
- I %<1!(%=2) D EXIT Q
- I %=1 D TRANS
- MESS W !!?10,"Transfer of patients is complete."
- W !?10,"All patients should be reviewed and all"
- W !?10,"patient data updated in the ",BDMREGNM," register."
- W !
- D PAUSE^BDMFMENU
- Q
- TRANS S $P(^ACM(41.1,BDMRG,0),U,9)=1
- S BDMGLB="^DIBT("_BDMTRN_",1)"
- S BDMU=0
- F S BDMU=$O(@BDMGLB@(BDMU)) Q:BDMU="" D:'$D(^ACM(41,"AC",BDMU,BDMRG)) MOVE
- S $P(^ACM(41.1,BDMRG,0),U,9)=""
- K BDMRG,BDMRGNA,BDMU,BDMTRN,BDMTRNA,BDMTRNX,BDMRGTP,BDMX,BDMI,BDMSLCT,DIC,DIE,DA,DR,DD
- S ZTREQ="@"
- Q
- MOVE Q:$D(^ACM(41,"AC",BDMU,BDMRG))
- S:$P(^ACM(41.1,BDMRG,0),U,9)="" $P(^(0),U,9)=1
- S DIC="^ACM(41,"
- S DIC(0)="L"
- S DIC("DR")=".02////"_BDMU_";1////"_BDMSTAT_";2////"_DT_";4////"_DT
- S X=BDMRG
- D FILE^BDMFDIC
- W "."
- Q
- TSK S ZTRTN="TRANS^BDMTRANS",ZTDESC="TRANSFER PCC REGISTER OR TAXONOMY DATA TO CMS REGISTER",ZTSAVE("BDM*")="",ZTIO="",ZTDTH=$H
- D ^%ZTLOAD
- Q
- TLOOK W @IOF
- W !?20,"Select SEARCH TEMPLATE to transfer"
- W !?20,"patients to the Diabetes Register"
- W !!
- K DIC
- S DIC="^DIBT("
- S DIC(0)="AEQZ"
- S DIC("A")="Which SEARCH TEMPLATE: "
- S DIC("S")="I (($P(^(0),U,4)=2!($P(^(0),U,4)=9000001))) Q:'$D(DS(2)) I $D(^DIBT(DS(2),1))"
- D ^DIC
- K DIC,DA,DR
- Q:+Y<1
- W !
- S BDMTRN=+Y,BDMTRNA=$P(Y,U,2),(BDMRGTP,BDMI)=""
- F BDMYI=1:1 S BDMI=$O(^DIBT(BDMTRN,1,BDMI)) Q:BDMI=""
- W !!?10,"There are ",BDMYI-1," patients in this SEARCH TEMPLATE."
- K BDMI,BDMYI
- W !
- S BDMYI=0
- F S BDMYI=$O(^DIBT(BDMTRN,"%D",BDMYI)) Q:'BDMYI W !,?3,^(BDMYI,0)
- K BDMYI
- W !
- Q
- BDMTRANS ; cmi/anch/maw - CONTROL TRANSFER OF PATIENTS TO CMS ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
- +2 ;UTILITY TO TRANSFER CLIENTS FROM PCC REGISTERS, TAXONOMIES AND
- +3 ;SEARCH TEMPLATES TO THE CMS
- +4 ;;EP;ENTRY POINT
- EN IF '$GET(BDMRDA)
- DO REG^BDMFUTIL
- +1 IF '$GET(BDMRDA)
- QUIT
- +2 IF '$DATA(BDMQUIT)
- DO PCC
- EXIT KILL BDMRG,BDMRGNA,BDMU,BDMTRN,BDMTRNA,BDMTRNX,BDMRGTP,BDMX,BDMI,BDMSLCT
- +1 KILL BDMQUIT,BDM1,BDM2,BDM3,BDMGLB,BDMGLB1
- +2 QUIT
- +3 ;
- PCC DO TLOOK
- +1 IF Y<1
- QUIT
- +2 SET BDMRG=BDMRDA
- +3 SET BDMSTAT="A"
- SET BDMSTAT(0)="ACTIVE"
- +4 WRITE !!?10,"The following transfer has been selected:",!!?10,"From SEARCH TEMPLATE: "
- +5 WRITE ?30,BDMTRNA,!?12,"To CMS register:",?30,BDMREGNM,!?10,"Transfer Status: ",?30,BDMSTAT," - ",BDMSTAT(0),!!,?10,"Is that what you want"
- +6 SET %=2
- DO YN^DICN
- +7 IF %<1!(%=2)
- DO EXIT
- QUIT
- +8 IF %=1
- DO TRANS
- MESS WRITE !!?10,"Transfer of patients is complete."
- +1 WRITE !?10,"All patients should be reviewed and all"
- +2 WRITE !?10,"patient data updated in the ",BDMREGNM," register."
- +3 WRITE !
- +4 DO PAUSE^BDMFMENU
- +5 QUIT
- TRANS SET $PIECE(^ACM(41.1,BDMRG,0),U,9)=1
- +1 SET BDMGLB="^DIBT("_BDMTRN_",1)"
- +2 SET BDMU=0
- +3 FOR
- SET BDMU=$ORDER(@BDMGLB@(BDMU))
- IF BDMU=""
- QUIT
- IF '$DATA(^ACM(41,"AC",BDMU,BDMRG))
- DO MOVE
- +4 SET $PIECE(^ACM(41.1,BDMRG,0),U,9)=""
- +5 KILL BDMRG,BDMRGNA,BDMU,BDMTRN,BDMTRNA,BDMTRNX,BDMRGTP,BDMX,BDMI,BDMSLCT,DIC,DIE,DA,DR,DD
- +6 SET ZTREQ="@"
- +7 QUIT
- MOVE IF $DATA(^ACM(41,"AC",BDMU,BDMRG))
- QUIT
- +1 IF $PIECE(^ACM(41.1,BDMRG,0),U,9)=""
- SET $PIECE(^(0),U,9)=1
- +2 SET DIC="^ACM(41,"
- +3 SET DIC(0)="L"
- +4 SET DIC("DR")=".02////"_BDMU_";1////"_BDMSTAT_";2////"_DT_";4////"_DT
- +5 SET X=BDMRG
- +6 DO FILE^BDMFDIC
- +7 WRITE "."
- +8 QUIT
- TSK SET ZTRTN="TRANS^BDMTRANS"
- SET ZTDESC="TRANSFER PCC REGISTER OR TAXONOMY DATA TO CMS REGISTER"
- SET ZTSAVE("BDM*")=""
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- +1 DO ^%ZTLOAD
- +2 QUIT
- TLOOK WRITE @IOF
- +1 WRITE !?20,"Select SEARCH TEMPLATE to transfer"
- +2 WRITE !?20,"patients to the Diabetes Register"
- +3 WRITE !!
- +4 KILL DIC
- +5 SET DIC="^DIBT("
- +6 SET DIC(0)="AEQZ"
- +7 SET DIC("A")="Which SEARCH TEMPLATE: "
- +8 SET DIC("S")="I (($P(^(0),U,4)=2!($P(^(0),U,4)=9000001))) Q:'$D(DS(2)) I $D(^DIBT(DS(2),1))"
- +9 DO ^DIC
- +10 KILL DIC,DA,DR
- +11 IF +Y<1
- QUIT
- +12 WRITE !
- +13 SET BDMTRN=+Y
- SET BDMTRNA=$PIECE(Y,U,2)
- SET (BDMRGTP,BDMI)=""
- +14 FOR BDMYI=1:1
- SET BDMI=$ORDER(^DIBT(BDMTRN,1,BDMI))
- IF BDMI=""
- QUIT
- +15 WRITE !!?10,"There are ",BDMYI-1," patients in this SEARCH TEMPLATE."
- +16 KILL BDMI,BDMYI
- +17 WRITE !
- +18 SET BDMYI=0
- +19 FOR
- SET BDMYI=$ORDER(^DIBT(BDMTRN,"%D",BDMYI))
- IF 'BDMYI
- QUIT
- WRITE !,?3,^(BDMYI,0)
- +20 KILL BDMYI
- +21 WRITE !
- +22 QUIT
