QAOSCNV5.m

QAOSCNV5 ;HISC/DAD-CONVERT TEXT OF EXCEPTIONS ;9/9/93  13:54

 ;;3.0;Occurrence Screen;;09/14/1993

 W !!,"Converting text of exceptions"

 W !,"-----------------------------"

 I $O(^QA(741.1,0))'>0,$O(^QA(741.5,0)) D  Q

 . S DIU="^QA(741.5,",DIU(0)="DT" D EN^DIU2

 . Q

 F QAOEXCP=1:1 S QAOSDATA=$P($T(EXCEPT+QAOEXCP),";;",2) Q:QAOSDATA=""  D

 . S QAOSSCRN=+QAOSDATA,QAOSCODE=$P(QAOSDATA,"^",2)

 . S QAOSTEXT=$P(QAOSDATA,"^",3)

 . W !!,"Screen: ",QAOSSCRN,?20,"Code: ",QAOSCODE

 . S (QAOSD0,QAOSDONE)=0

 . F  S QAOSD0=$O(^QA(741.5,"C",QAOSSCRN,QAOSD0)) Q:QAOSD0'>0!QAOSDONE  D

 .. S QAOSZERO=$G(^QA(741.5,QAOSD0,0))

 .. Q:$P(QAOSZERO,"^",3)'=QAOSCODE

 .. W !?5,"From: ",$P(QAOSZERO,"^")

 .. W !?5,"To:   ",QAOSTEXT

 .. K DA,DIE,DR

 .. S DIE="^QA(741.5,",DA=QAOSD0,DR=".01///"_QAOSTEXT

 .. D ^DIE

 .. S QAOSDONE=1

 .. Q

 . W:'QAOSDONE !?5,"*** NOT FOUND ***"

 . Q

 K DA,DIE,DR,QAOEXCP,QAOSCODE,QAOSD0,QAOSDATA

 K QAOSDONE,QAOSSCRN,QAOSTEXT,QAOSZERO

 Q

EXCEPT ;;SCREEN ^ CODE ^ NEW_EXCEPTION_TEXT

 ;;107^2^TWO OPERATIONS SEPARATED BY MORE THAN 7 DAYS

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAOSCNV5   1075     printed  Apr 09, 2024@21:23:28                                                                                                                                                                                                    Page 2

QAOSCNV5  ;HISC/DAD-CONVERT TEXT OF EXCEPTIONS ;9/9/93  13:54

 +1       ;;3.0;Occurrence Screen;;09/14/1993

 +2        WRITE !!,"Converting text of exceptions"

 +3        WRITE !,"-----------------------------"

 +4        IF $ORDER(^QA(741.1,0))'>0

               IF $ORDER(^QA(741.5,0))

                   Begin DoDot:1

 +5                    SET DIU="^QA(741.5,"

                       SET DIU(0)="DT"

                       DO EN^DIU2

 +6                    QUIT 

                   End DoDot:1

                   QUIT 

 +7        FOR QAOEXCP=1:1

               SET QAOSDATA=$PIECE($TEXT(EXCEPT+QAOEXCP),";;",2)

               if QAOSDATA=""

                   QUIT 

               Begin DoDot:1

 +8                SET QAOSSCRN=+QAOSDATA

                   SET QAOSCODE=$PIECE(QAOSDATA,"^",2)

 +9                SET QAOSTEXT=$PIECE(QAOSDATA,"^",3)

 +10               WRITE !!,"Screen: ",QAOSSCRN,?20,"Code: ",QAOSCODE

 +11               SET (QAOSD0,QAOSDONE)=0

 +12               FOR 

                       SET QAOSD0=$ORDER(^QA(741.5,"C",QAOSSCRN,QAOSD0))

                       if QAOSD0'>0!QAOSDONE

                           QUIT 

                       Begin DoDot:2

 +13                       SET QAOSZERO=$GET(^QA(741.5,QAOSD0,0))

 +14                       if $PIECE(QAOSZERO,"^",3)'=QAOSCODE

                               QUIT 

 +15                       WRITE !?5,"From: ",$PIECE(QAOSZERO,"^")

 +16                       WRITE !?5,"To:   ",QAOSTEXT

 +17                       KILL DA,DIE,DR

 +18                       SET DIE="^QA(741.5,"

                           SET DA=QAOSD0

                           SET DR=".01///"_QAOSTEXT

 +19                       DO ^DIE

 +20                       SET QAOSDONE=1

 +21                       QUIT 

                       End DoDot:2

 +22               if 'QAOSDONE

                       WRITE !?5,"*** NOT FOUND ***"

 +23               QUIT 

               End DoDot:1

 +24       KILL DA,DIE,DR,QAOEXCP,QAOSCODE,QAOSD0,QAOSDATA

 +25       KILL QAOSDONE,QAOSSCRN,QAOSTEXT,QAOSZERO

 +26       QUIT 

EXCEPT    ;;SCREEN ^ CODE ^ NEW_EXCEPTION_TEXT

 +1       ;;107^2^TWO OPERATIONS SEPARATED BY MORE THAN 7 DAYS