| 1 | VADPT61 ;ALB/MJK - Patient ID Utilities (cont.); 12 AUG 89 @1200
|
|---|
| 2 | ;;5.3;Registration,;**749**;Aug 13, 1993;Build 10
|
|---|
| 3 | ;
|
|---|
| 4 | 1 ;;ID Format Enter/Edit
|
|---|
| 5 | W ! S DIC="^DIC(8.2,",DIC(0)="AELMQ" D ^DIC K DIC G Q1:+Y<1
|
|---|
| 6 | S DA=+Y,DIE="^DIC(8.2,",DR="[DG ID FORMAT ENTER/EDIT]" D ^DIE G 1
|
|---|
| 7 | Q1 K DIE,DR,DA,Y Q
|
|---|
| 8 | ;
|
|---|
| 9 | 2 ;;Eligibility Code Enter/Edit
|
|---|
| 10 | W ! S DIC="^DIC(8,",DIC(0)="AELMQ",DIC("DR")=8 D ^DIC K DIC G Q2:+Y<1
|
|---|
| 11 | S DA=+Y,DIE="^DIC(8,",DR="[DG ELIG ENTER/EDIT]" D ^DIE G 2
|
|---|
| 12 | Q2 K DIE,DR,DA,Y
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | ASK ;
|
|---|
| 16 | Q:$S('$D(^DIC(8.2,+$P(^DIC(8,VAELG,0),U,10),0)):1,1:'$P(^(0),U,2))
|
|---|
| 17 | W !!,*7,"User Input Needed for '",$P(^DIC(8,VAELG,0),U),"' id:"
|
|---|
| 18 | S DIE="^DPT("_DFN_",""E"",",DR=.03,DA(1)=DFN,DA=VAELG D ^DIE
|
|---|
| 19 | W !!?5,"...",$P(^DIC(8,VAELG,0),U)
|
|---|
| 20 | K DIE,DR,DA,Y
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | WARN ; -- interaction warning
|
|---|
| 24 | I $P(X,U,2) W !!?5,*7,"WARNING: User interaction usually is required for this format."
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BEG ;
|
|---|
| 28 | S VASTART=$$NOW^XLFDT
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | END ;
|
|---|
| 32 | S VAEND=$$NOW^XLFDT,L=0
|
|---|
| 33 | K XMY
|
|---|
| 34 | S XMSUB=$P($T(OPTS+VAOPT),";",4),XMDUZ=.5,XMTEXT="VATEXT(",XMY(DUZ)=""
|
|---|
| 35 | I VAOPT=3 S XMSUB=XMSUB_" (Format: "_$S($D(^DIC(8.2,VAFMT,0)):$P(^(0),U),1:"UNKNOWN")_")"
|
|---|
| 36 | I VAOPT=5 S XMSUB=XMSUB_" (Eligibility: "_$S($D(^DIC(8,VAELG,0)):$P(^(0),U),1:"UNKNOWN")_")"
|
|---|
| 37 | S L=L+1 S VATEXT(L,0)=" "
|
|---|
| 38 | S Y=VASTART,L=L+1 X ^DD("DD") S VATEXT(L,0)=" Job started at "_Y
|
|---|
| 39 | S Y=VAEND,L=L+1 X ^DD("DD") S VATEXT(L,0)=" Job completed at "_Y
|
|---|
| 40 | D ^XMD
|
|---|
| 41 | K VAOPT,VASTART,VAEND,L,VATEXT,XMY,XMSUB,XMDUZ,XMTEXT,Y,% Q
|
|---|
| 42 | ;
|
|---|
| 43 | TASK ;
|
|---|
| 44 | W !!?5,"The resetting of ID formats can take many hours."
|
|---|
| 45 | W !?5,"It is suggested that it be run at off-peak hours,"
|
|---|
| 46 | W !?5,"perferably over a weekend.",!
|
|---|
| 47 | K ZTSK S X=$T(OPTS+VAOPT),VARS=$P(X,";",5)
|
|---|
| 48 | F I=1:1 S Y=$P(VARS,"^",I) Q:Y="" S ZTSAVE(Y)=""
|
|---|
| 49 | S ZTSAVE("VAOPT")="",ZTRTN="QUE"_VAOPT_"^VADPT60",ZTDESC=$P(X,";",4),ZTIO="" D ^%ZTLOAD
|
|---|
| 50 | I $D(ZTSK) W !!,"Job has been queued. (Task #",ZTSK,")",!,"A MailMan message will be sent to you when the job has completed."
|
|---|
| 51 | TASKQ K ZTIO,ZTRTN,ZTDESC,ZTSAVE,VARS,Y,X,ZTSK Q
|
|---|
| 52 | ;
|
|---|
| 53 | OPTS ; -- queue task list ;;opt#;description;vars to save
|
|---|
| 54 | ;;1;none
|
|---|
| 55 | ;;2;none
|
|---|
| 56 | ;;3;Reset ID Format;VAFMT
|
|---|
| 57 | ;;4;Reset Primary Eligibilty ID Format
|
|---|
| 58 | ;;5;Reset Specific Eligibilty ID Format;VAELG
|
|---|
| 59 | ;;6;none
|
|---|
| 60 | ;;7;Reset All ID Formats for all Patients
|
|---|
