source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPFDS.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1LRCAPFDS ;DALOI/FHS - EDIT ACTIVATED WKLD CODES BY WKLD LAB SECTION ;5/1/99
2 ;;5.2;LAB SERVICE;**105,119,127,163,274,362**;Sep 27, 1994;Build 11
3EN ;
4 K ^TMP("LRLAM",DUZ_$J),DIR W !
5 S DIR("?")="Select any individual WKLD CODE then edit all fields"
6 S DIR("A")="Do you want to edit specific WKLD CODES/ALL fields? "
7 S DIR(0)="Y",DIR("B")="N" D ^DIR G:$D(DIRUT) END
8 I Y=1 D G END
9 . F W ! K DIC S DIC=64,DIC(0)="AQEZNM" D ^DIC Q:Y<1 D
10 . . N DA,DIE,DR
11 . . S DA=+Y,DR="[LR WKLD EDIT ALL]",DIE="^LAM(" D ^DIE
12 I '$O(^LAM("AC",1,0)) W !?5,"You have no Activated WKLD CODES ",! G END
13 W !?5,"This option will allow you to Edit or Print WKLD CODES"
14 K DIR,LRSECT S DIR("A")="Do you want to select a specific WKLD CODE LAB SECTION"
15 S DIR(0)="Y",DIR("B")="Y" D ^DIR G:$D(DIRUT) END
16 I Y K DIC,DIR S DIC=64.21,DIC(0)="AEQZNM" D ^DIC G:Y<1 END S LRSECT=+Y
17 K DIR,DIC S DIR(0)="S^E:EDIT;P:PRINT",DIR("A")="Would you like to"
18 D ^DIR G END:$D(DIRUT) G:Y="P" PRINT
19EDIT ;
20 W !,"EDITING",! K DIR
21 S DIR(0)="S,O^1:ALL;.02:DESCRIPT;4:BILLABLE PROCEDURE;7:COST;8:PRICE;9:SORTING GROUP;13:WKLD CODE LAB SECTION;14:DSS Feeder;18:CODE;19:SYNONYM;20:SPECIMEN;21:LOCAL ACC AREA;26:ES DISPLAY ORDER"
22 S DIR("A")="Select a field you want to edit ",LRDR=""
23ASK D ^DIR G:X=U END I Y=1 S LRDR="[LR WKLD EDIT ALL]" D LRSET G ALL
24 I Y S LRDR=LRDR_Y_";" S DIR("A")="Select Another Field " G ASK
25 I '$L(LRDR) W !?5,"Nothing Selected ",! G END
26 S LRDR=$E(LRDR,1,($L(LRDR)-1))
27 D LRSET
28ALL I '$D(^TMP("LRLAM",DUZ_$J)) W !!,$$CJ^XLFSTR(" Database scan was negative.",80),!,$$CJ^XLFSTR(" No WKLD CODES assigned to WKLD CODE LAB SECTION you selected.",80),$C(7),! G END
29 K DIR S DIR(0)="F^1:60",DIR("A")="Start with what WKLD CODE name",DIR("A",2)="Use mixed case Characters e.g Chloride "
30 S DIR("A",1)=""
31 D ^DIR G:$D(DIRUT) END
32 S LRWKLD=X W !,"STARTING LOOP ",!
33LOOP ;
34 S LRWKLD=$O(^TMP("LRLAM",DUZ_$J,$E(LRWKLD,1,$L(LRWKLD)-1))),LRNN=DUZ_$J
35 I LRWKLD="" W !!?5,"Nothing matches your criteria",! G END
36 S LRNODE="^TMP(""LRLAM"","_DUZ_$J_","""_LRWKLD_""",0)",LREND=0 W @IOF
37 F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'=LRNN!($G(LREND)) S DA=+$QS(LRNODE,4) I DA D
38 . D DIQ S:$G(DIRUT) LREND=1 Q:LREND=1 S S=0,DR=LRDR,DIE=64 D ^DIE S:$D(Y)!(X="^") LREND=1
39 G END
40 Q
41PRINT ;
42 K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Would you like only CPT linked WKLD CODES" D ^DIR G:$D(DIRUT) END
43 S LRCPT=Y
44 W !,"PRINT",! K %ZIS S %ZIS="QN" D ^%ZIS G:POP END
45 I IO'=IO(0) D D ^%ZISC G END
46 . S:$G(LRSECT) ZTSAVE("LRSECT")="" S ZTRTN="DQ^LRCAPFDS",ZTSAVE("LRCPT")="",ZTIO=ION
47 . K ZTSK D ^%ZTLOAD W:$G(ZTSK) !?5,"Report Queued to "_ION I '$G(ZTSK) W !!?10,"**** Report Not Queued ****",!
48DQ ;
49 S:$D(ZTQUEUED) ZTREQ="@" D LRSET
50 I '$D(^TMP("LRLAM",DUZ_$J)) W !!?10," Database scan was negative.",!," No WKLD CODES assigned to WKLD CODE LAB SECTION you selected.",! G END
51 S S=5,LRNODE="^TMP(""LRLAM"","_DUZ_$J_",0)",DIC="^LAM(",DR="0:99",LREND=0
52 K DIR S LRNN=DUZ_$J D HEAD
53 F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'=LRNN!($G(LREND)) S DA=+$QS(LRNODE,4) I DA D
54 . D EN^LRDIQ S:$D(DIRUT) LREND=1 S S=S+2 S:$E(IOST,1,2)'="C-" S=0
55 Q
56END ;
57 W ! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
58 K DA,DIC,DIE,DIR,DR,DTOUT,DUOUT,DIRUT
59 K LRDAT,LREND,LRN,LRNN,LRNODE,LRSECT,LRTIT,LRWKLD,S
60 K X,Y,LRDR,ZTSK,%ZIS,DIRUT,LRCPT
61 Q
62HEAD ;
63 W !!,$$CJ^XLFSTR("Activated WKLD Codes",IOM),!
64 S LRTIT=" WKLD LAB SECTION [ "_$S($D(^LAB(64.21,+$G(LRSECT),0)):$P(^(0),U),1:"** ALL **")_" ]"
65 S LRDAT=$$HTE^XLFDT($H),S=6
66 W $$CJ^XLFSTR(LRTIT,IOM),!,$$CJ^XLFSTR(LRDAT,IOM),!
67 Q
68DIQ ;
69 Q:'$G(DA) W ! S DIC="^LAM(",DR=0 D EN^LRDIQ
70 Q
71LRSET ;
72 S LRN=0 F S LRN=$O(^LAM(LRN)) Q:LRN<1 I $D(^LAM(LRN,0))#2 S LRNODE=^(0) D
73 . I $G(LRSECT),$P(LRNODE,U,15)'=LRSECT Q
74 . I $G(LRCPT),'$O(^LAM(LRN,4,0)) Q
75 . S ^TMP("LRLAM",DUZ_$J,$P(LRNODE,U),LRN)=$P(LRNODE,U,2)
76 Q
Note: See TracBrowser for help on using the repository browser.