source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSCLOZ.m@ 767

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1PSSCLOZ ;BIR/TTH-CLOZAPINE DRUG ENTER/EDIT CLOZAPINE ; 01/25/99
2 ;;1.0;PHARMACY DATA MANAGEMENT;**19,90**;9/30/97
3 ;
4 ;Reference to ^LAB(60 supported by DBIA #10054
5 ;Reference to ^LAB(61 supported by DBIA #10055
6 ;
7 Q:'$D(DISPDRG)
8 N DA,DIC,DIE,DIK,DINUM,DIR,DR,PSSANS,PSSANS2,PSSCIM,PSSCLO,PSSCNT,PSSCRN,PSSIEN,PSSLAB1,PSSLAB2,PSSLT,PSSLTN,PSSNN,PSSNUM,PSSOPP,PSSPTY,PSSPTYN,PSSSUB,PSSTOT,PSSTUFF,PSSTYP0,PSSXX,X,Y
9 K DIRUT,DUOUT
10 ;Mark drug for Clozapine and create "ACLOZ" cross-reference.
11 S DA=DISPDRG,DIE=50,DR="17.5///^S X=""PSOCLO1""" D ^DIE K DA,DIE
12 ;
13CLOZBEG I $D(DIRUT)!($D(DUOUT)) Q
14 S (PSSIEN,PSSCNT)=0
15 I $O(^PSDRUG(DISPDRG,"CLOZ2",0)) F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN)) Q:'PSSIEN D
16 .S PSSSUB=$P($G(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN,0)),U),PSSTYP0=$P($G(^(0)),U,4),PSSCIM=$P($G(^(0)),U,3)
17 .K PSSLAB1,PSSLAB2 S PSSLAB1=$$GET1^DIQ(60,PSSSUB,.01,"I"),PSSLAB2=$$GET1^DIQ(61,PSSCIM,.01,"I")
18 .S PSSCNT=PSSCNT+1,PSSCLO(PSSCNT)=$S($D(PSSLAB1):PSSLAB1,1:"**Unknown Lab Test**")_"^"_PSSSUB_"^"_PSSIEN_"^"_PSSTYP0_"^"_$S($D(PSSLAB2):PSSLAB2,1:"**Unknown Lab Test**")
19 W !!,"Prescription of Clozapine requires identification of two",!,"laboratory tests, WBC and Absolute Neutrophil Count (ANC).",!!
20 I PSSCNT=0 W "You do not have any laboratory tests identified." W !! S DIR(0)="SOA^WBC:WBC;ANC:ANC",DIR("B")="WBC" S DIR("A")="Select Laboratory Test Type: " D ^DIR Q:$D(DIRUT) S PSSTUFF=Y K DIR,X,Y G CLOZBG2
21 I PSSCNT=1 W "You have one laboratory type of "_$S(PSSTYP0=1:"WBC",PSSTYP0=2:"ANC",1:"**Unknown**")_" test identified." S PSSTUFF=$S(PSSTYP0=2:1,1:2)
22 I PSSCNT>1 W "You currently have both laboratory tests identified."
23 ;
24 D DISPLAY
25 ;
26CLOZBG2 I PSSCNT=0 S PSSANS="A" D CLOZSEL Q
27 S DIR("?")="Enter the letter that correspond with the function."
28 I PSSCNT=1 D Q:$D(DIRUT)
29 .S PSSOPP=$S(PSSTYP0=2:"WBC",PSSTYP0=1:"ANC",1:"**Data Missing**")
30 .W !!,"A second laboratory type of "_PSSOPP_" test should be added.",! S DIR(0)="SOA^A:ADD;E:EDIT;D:DELETE",DIR("A")="(A)dd, (E)dit, or (D)elete entry? " D ^DIR Q:$D(DIRUT)
31 I PSSCNT>1 W !! S DIR(0)="SOA^E:EDIT;D:DELETE",DIR("A")="(E)dit or (D)elete entry? " D ^DIR Q:$D(DIRUT)
32 S PSSANS=Y D CLOZSEL Q:$D(DIRUT)
33 ;
34END ;Kill variables.
35 K DIC,DIE,DIK,DIR,DR,PSSANS,PSSANS2,PSSCNT,PSSSUB,PSSXX,X,Y
36 Q
37 ;
38DISPLAY ;Display lab test.
39 W !!!,?2,"Type of",!,?2,"Test",?12,"Lab Test Monitor",?55,"Specimen Type",!,?2,"-------",?12,"----------------",?55,"-------------"
40 Q:'$O(PSSCLO(0)) W ! F PSSXX=0:0 S PSSXX=$O(PSSCLO(PSSXX)) Q:'PSSXX D
41 .S PSSTOT=$P($G(PSSCLO(PSSXX)),U,4)
42 .W !,?2,PSSXX_". "_$S(PSSTOT=1:"WBC",PSSTOT=2:"ANC",1:"**Unknown**"),?12,$P(PSSCLO(PSSXX),U),?55,$E($P(PSSCLO(PSSXX),U,5),1,20)
43 Q
44 ;
45CLOZSEL ;Execute add, edit or delete submodule.
46 I PSSCNT>1,($G(PSSANS)'="A") D CLOZASK Q:$D(DIRUT)
47 I PSSANS="D" D:PSSCNT=1 CLOZASK D CLOZDEL Q
48 I PSSANS="E" D:PSSCNT=1 CLOZASK D CLOZEDT Q
49 ;
50CLOZADD ;Add Clozapine sub-entry
51 Q:$D(DIRUT)
52 D DISPLY2 Q:$D(DIRUT) I Y=0 D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
53CLOZAD2 K DIC,DD,DO S X=PSSLTN,DA(1)=DISPDRG,DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
54 S DIC(0)="L",DIC("P")="50.02P"
55 S DIC("DR")="2///"_PSSPTYN_";3///"_PSSTUFF
56 D FILE^DICN K DD,DO I Y=-1 S (DUOUT,DIRUT)=1 K DIC,DA,X,Y Q
57 D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
58 Q
59 ;
60CLOZEDT ;Edit Clozapine sub-entry
61 Q:$D(DIRUT) K DIE,DR,X,Y S DA=PSSANS2
62 S DIE="^PSDRUG(DISPDRG,""CLOZ2"","
63 S DR=".01;2;3///"_PSSTUFF D ^DIE I $D(Y) S (DUOUT,DIRUT)=1 D CLOZDXX K ^PSDRUG(DISPDRG,"CLOZ2"),DIE,DR,X,Y Q
64 D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
65 Q
66 ;
67CLOZDEL ;Delete Clozapine sub-entry
68 Q:$D(DIRUT) I PSSCNT<3 W !,"You must have a test defined for WBC and ANC to dispense Clozapine.",!
69 S DIR("A")="Are you sure that you want to delete this test",DIR("?")="Enter YES to delete the laboratory test, NO to return to selection.",DIR(0)="Y",DIR("B")="NO" D ^DIR Q:$D(DIRUT) I +Y=0 D END W !! K PSSCLO G CLOZBEG
70 ;
71CLOZDXX K DIK,X,Y
72 S DA(1)=DISPDRG,DA=PSSANS2,DIK="^PSDRUG(DISPDRG,""CLOZ2"","
73 D ^DIK K DIK,X,Y
74 I PSSANS="E",PSSCNT>1 Q
75 Q:PSSANS="A" W !!,"Deleting "_$P(PSSCLO(PSSNUM),U)_"...."
76 D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
77 Q
78CLOZASK ;Select LAB Test number.
79 I $D(DIRUT)!($D(DUOUT)) Q
80 W ! K DIR,Y S DIR(0)="NA^1:"_PSSCNT_":1",DIR("A")="Select the Number of the test you want to "_$S(PSSANS="D":"delete",1:"edit")_" (1 or "_PSSCNT_"): "
81 S DIR("?")="Enter the number you want to delete or edit." D ^DIR Q:$D(DIRUT)
82 S PSSNUM=+Y,PSSANS2=$P(PSSCLO(PSSNUM),U,3) I PSSANS="E" S PSSTUFF=$P(PSSCLO(PSSNUM),U,4) I PSSCNT>1 D Q:$D(DIRUT) I Y=0 D END W !! K PSSCLO G CLOZBEG
83 .S PSSNN=$S(PSSNUM=1:2,1:1),PSSCRN=$P(PSSCLO(PSSNN),U,2)
84 .D DISPLY3 Q:$D(DIRUT)!(Y=0)
85 .D CLOZDXX ;Delete selected entry.
86 .D CLOZAD2 ;Add entry with new changes.
87 Q
88 ;
89DISPLY2 ;Display selection before adding to file.
90 Q:$D(DIRUT) S PSSCRN=$P($G(PSSCLO(1)),U,2)
91DISPLY3 K DIR,X,Y W ! S DIR(0)="P^60:EMAQZ",DIR("S")="I PSSCRN'=+Y" D ^DIR Q:$D(DIRUT) S PSSLTN=+Y,PSSLT=$P(Y,U,2)
92 K DIR,X,Y S DIR(0)="P^61:EMAQZ",DIR("A")="Select SPECIMEN TYPE" D ^DIR Q:$D(DIRUT) S PSSPTYN=+Y,PSSPTY=$P(Y,U,2) K DIR,X,Y
93 W !!,"You have selected the following information for",!,"a Laboratory Type of "_$S(PSSTUFF=2:"ANC",1:"WBC")_" test."
94 W !!,?2,"Lab Test Monitor: "_PSSLT,!,?2,"Specimen Type : "_PSSPTY
95 K DIR,X,Y W !! S DIR("A")="Is this correct",DIR("?")="Enter YES to accept, NO to reject.",DIR(0)="Y",DIR("B")="YES" D ^DIR
96 Q
97 ;
98CLOZMOV ;In File #50, move data CLOZ node to CLOZ2 node.
99 N PSSIEN,PSSGLO
100 S (PSSIEN,PSSGLO)=0
101 F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG(PSSIEN)) Q:'PSSIEN I $P($G(^PSDRUG(PSSIEN,"CLOZ1")),"^")="PSOCLO1" D
102 .S ^PSDRUG("ACLOZ",PSSIEN)="",PSSGLO=^PSDRUG(PSSIEN,"CLOZ")
103 .K DIC,DD,DO,X S (DA,DINUM)=1,DA(1)=PSSIEN,X=$P(PSSGLO,"^") Q:'X
104 .S DIC("P")="50.02P",DIC(0)="L"
105 .S DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
106 .S DIC("DR")="1////"_$P(PSSGLO,"^",2)_";2////"_$P(PSSGLO,"^",3)_";3///1"
107 .D FILE^DICN K DIC,DA
108 Q
Note: See TracBrowser for help on using the repository browser.