source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSCNV5.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1QAOSCNV5 ;HISC/DAD-CONVERT TEXT OF EXCEPTIONS ;9/9/93 13:54
2 ;;3.0;Occurrence Screen;;09/14/1993
3 W !!,"Converting text of exceptions"
4 W !,"-----------------------------"
5 I $O(^QA(741.1,0))'>0,$O(^QA(741.5,0)) D Q
6 . S DIU="^QA(741.5,",DIU(0)="DT" D EN^DIU2
7 . Q
8 F QAOEXCP=1:1 S QAOSDATA=$P($T(EXCEPT+QAOEXCP),";;",2) Q:QAOSDATA="" D
9 . S QAOSSCRN=+QAOSDATA,QAOSCODE=$P(QAOSDATA,"^",2)
10 . S QAOSTEXT=$P(QAOSDATA,"^",3)
11 . W !!,"Screen: ",QAOSSCRN,?20,"Code: ",QAOSCODE
12 . S (QAOSD0,QAOSDONE)=0
13 . F S QAOSD0=$O(^QA(741.5,"C",QAOSSCRN,QAOSD0)) Q:QAOSD0'>0!QAOSDONE D
14 .. S QAOSZERO=$G(^QA(741.5,QAOSD0,0))
15 .. Q:$P(QAOSZERO,"^",3)'=QAOSCODE
16 .. W !?5,"From: ",$P(QAOSZERO,"^")
17 .. W !?5,"To: ",QAOSTEXT
18 .. K DA,DIE,DR
19 .. S DIE="^QA(741.5,",DA=QAOSD0,DR=".01///"_QAOSTEXT
20 .. D ^DIE
21 .. S QAOSDONE=1
22 .. Q
23 . W:'QAOSDONE !?5,"*** NOT FOUND ***"
24 . Q
25 K DA,DIE,DR,QAOEXCP,QAOSCODE,QAOSD0,QAOSDATA
26 K QAOSDONE,QAOSSCRN,QAOSTEXT,QAOSZERO
27 Q
28EXCEPT ;;SCREEN ^ CODE ^ NEW_EXCEPTION_TEXT
29 ;;107^2^TWO OPERATIONS SEPARATED BY MORE THAN 7 DAYS
Note: See TracBrowser for help on using the repository browser.