Changeset 623 for WorldVistAEHR/trunk/r/DIETETICS-FH/FHORC5.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DIETETICS-FH/FHORC5.m
r613 r623 1 FHORC5 ; HISC/REL - Consult Management ;4/12/06 13:26 2 ;;5.5;DIETETICS;**4,12**;Jan 28, 2005;Build 3 3 ; 10/17/2007 BP/KAM FH*5.5*12 Rem Call 210883 Remove Old Clinician Field (#1) 4 EN9 ; Enter/Edit Ward Assignments 5 K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQM" 6 W ! D ^DIC G KIL:U[X!$D(DTOUT),EN9:Y<1 S OLD=$S($P(Y,"^",3):"",1:$P(^FH(119.6,+Y,0),"^",2)) 7 ; 10/17/2007 BP/KAM *12 Rem Call 210883 Removed field #1 in next line 8 S DA=+Y,DR="112" D ^DIE S NEW=$P(^FH(119.6,DA,0),"^",2) I 'NEW!('OLD) K OLD,NEW,X,Y G EN9 9 D:OLD'=NEW EN2^FHORC4 K OLD,NEW,X,Y G EN9 10 EN10 ; List Ward Assignments 11 W ! S L=0,DIC="^FH(119.6,",FLDS="[FHORWRD]",BY=".01" 12 S (FR,TO)="",DHD="NUTRITION LOCATION ASSIGNMENTS" D EN1^DIP,RSET Q 13 EN11 ; Enter/Edit Consult Types 14 S (DIC,DIE)="^FH(119.5,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=119.5 15 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN11:Y<1 16 S DA=+Y,DR=".01:2;S FHA1=X;3;S Y=$S(FHA1=""Y"":4,1:5);4;5:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.5 D ^DIE K DA,DIE,DIDEL,DR,FHA1 G EN11 17 EN12 ; List Consult Types 18 W !!,"The list requires a 132 column printer.",! 19 W ! S L=0,DIC="^FH(119.5,",FLDS="[FHORCON]",BY=".01" 20 S (FR,TO)="",DHD="CONSULTATION TYPES" D EN1^DIP,RSET Q 21 RSET K %ZIS S IOP="" D ^%ZIS 22 KIL K %,%ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,NEW,OLD,TO,X,Y Q 1 FHORC5 ; HISC/REL - Consult Management ;4/12/06 13:26 2 ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32 3 EN9 ; Enter/Edit Ward Assignments 4 K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQM" 5 W ! D ^DIC G KIL:U[X!$D(DTOUT),EN9:Y<1 S OLD=$S($P(Y,"^",3):"",1:$P(^FH(119.6,+Y,0),"^",2)) 6 S DA=+Y,DR="1;112" D ^DIE S NEW=$P(^FH(119.6,DA,0),"^",2) I 'NEW!('OLD) K OLD,NEW,X,Y G EN9 7 D:OLD'=NEW EN2^FHORC4 K OLD,NEW,X,Y G EN9 8 EN10 ; List Ward Assignments 9 W ! S L=0,DIC="^FH(119.6,",FLDS="[FHORWRD]",BY=".01" 10 S (FR,TO)="",DHD="NUTRITION LOCATION ASSIGNMENTS" D EN1^DIP,RSET Q 11 EN11 ; Enter/Edit Consult Types 12 S (DIC,DIE)="^FH(119.5,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=119.5 13 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN11:Y<1 14 S DA=+Y,DR=".01:2;S FHA1=X;3;S Y=$S(FHA1=""Y"":4,1:5);4;5:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.5 D ^DIE K DA,DIE,DIDEL,DR,FHA1 G EN11 15 EN12 ; List Consult Types 16 W !!,"The list requires a 132 column printer.",! 17 W ! S L=0,DIC="^FH(119.5,",FLDS="[FHORCON]",BY=".01" 18 S (FR,TO)="",DHD="CONSULTATION TYPES" D EN1^DIP,RSET Q 19 RSET K %ZIS S IOP="" D ^%ZIS 20 KIL K %,%ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,NEW,OLD,TO,X,Y Q
Note:
See TracChangeset
for help on using the changeset viewer.