source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY4.m@ 814

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

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1ORY4 ;SLB/MKB-postinit for OR*3.0*4 ;4/30/98 15:52
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4**;Dec 17, 1997
3 ;
4EN ; -- check orderables, dialogs, display groups
5 N DA,DIK S DIK="^DD(101.416,",DA(1)=101.416,DA=.04 D ^DIK
6 D OI^ORSETUP1 ; reset orderables pointers in quick orders
7 D DLG ; fix DG,SD,SR dialogs
8 N ORSEQ,ORX
9 F ORSEQ=1:1 S ORX=$T(DG+ORSEQ) Q:ORX["ZZZZZ" D ADD ; add new groups
10 Q
11 ;
12ADD ; -- add new group to file, to LAB as member
13 N X,Y,DA,DIC,DR,DIE,DLAYGO
14 S DIC="^ORD(100.98,",DIC(0)="LX",DLAYGO=100.98,DIE=DIC
15 S Y=+$O(^ORD(100.98,"B",$P(ORX,";",5),0))
16 I Y'>0 S X=$P(ORX,";",3) D ^DIC Q:Y'>0 ; error msg??
17 S DA=+Y,DR=".01///"_$P(ORX,";",3)_";2///"_$P(ORX,";",4)_";3///"_$P(ORX,";",5) D ^DIE
18 K X,Y,DA S DA(1)=+$O(^ORD(100.98,"B","LAB",0)) Q:'DA(1)
19 S DIC="^ORD(100.98,"_DA(1)_",1,",X=$P(ORX,";",5) D ^DIC
20 Q
21 ;
22DG ;;NAME;Mixed Name;SHORT NAME
23 ;;ELECTRON MICROSCOPY;Electron Microscopy;EM
24 ;;SURGICAL PATHOLOGY;Surg. Path.;SP
25 ;;AUTOPSY;Autopsy;AU
26 ;;CYTOLOGY;Cytology;CY
27 ;;ZZZZZ
28 ;
29DLG ; -- add save/restore calls to DG,SD,SR dialogs
30 N X,ORPKG,ORDLG,ENTRY,EXIT S ORDLG=0
31 F X="DG","SD","SR" S X=$O(^DIC(9.4,"C",X,0)) S:X ORPKG(X)=""
32 F S ORDLG=$O(^ORD(101.41,ORDLG)) Q:ORDLG'>0 S X=+$P($G(^(ORDLG,0)),U,7) I $D(ORPKG(X)) D
33 . S ENTRY=$G(^ORD(101.41,ORDLG,3)),EXIT=$G(^(4))
34 . S:ENTRY'["SAVE^ORXD" ENTRY="D SAVE^ORXD"_$S($L(ENTRY):" "_ENTRY,1:"")
35 . S:EXIT="D REBLD^ORCMENU" EXIT=""
36 . I $L(EXIT),EXIT["REBLD^ORCMENU" S EXIT=$P(EXIT," D REBLD^ORCMENU")
37 . S:EXIT'["RSTR^ORXD" EXIT=EXIT_$S($L(EXIT):" ",1:"")_"D RSTR^ORXD"
38 . S ^ORD(101.41,ORDLG,3)=ENTRY,^(4)=EXIT
39 Q
Note: See TracBrowser for help on using the repository browser.