XDRHLP.m

XDRHLP ;IHS/LAB/OHPRD;help logic for selected fields in 15, 15.1; [ 10/20/92  11:01 AM ]

 ;;7.3;TOOLKIT;;Apr 25, 1995

 ;

 ;this routine is called from files 15 and 15.1 and contains

 ;executable help prompts

 ;

 Q  ;no entry from top of routine, must use appropriate entry points

 ;

MD04 ;EP;called from .04 field of file 15, merge direction executable help

 S %=$P(^VA(15,DA,0),U,1,2) W !?5,"RECORD1=",$P(@(U_$P($P(%,U,1),";",2)_+%_",0)"),U,1)

 I $G(DUZ("AG"))="I",$P($P(%,U,1),";",2)="DPT(" D

 .S XDRHLP("F")=0,XDRHLP("I")=0

 .F XDRHLP("I")=0:1 S XDRHLP("F")=$O(^AUPNPAT(+%,41,XDRHLP("F"))) Q:XDRHLP("F")'=+XDRHLP("F")  D

 ..W:XDRHLP("I") ! W ?40," ",$J($P(^AUTTLOC(XDRHLP("F"),0),U,7),4)," ",$P(^AUPNPAT(+%,41,XDRHLP("F"),0),U,2),$S($P(^(0),U,3)="":"",1:"("_$P(^(0),U,5)_")")

 ..Q

 .K XDRHLP("F")

 .Q

 W !!,?5,"RECORD2=",$P(@(U_$P($P(%,U,2),";",2)_+$P(%,U,2)_",0)"),U,1)

 I $G(DUZ("AG"))="I",$P($P(%,U,1),";",2)="DPT(" D

 .S XDRHLP("F")=0,XDRHLP("I")=0

 .F XDRHLP("I")=0:1 S XDRHLP("F")=$O(^AUPNPAT(+$P(%,U,2),41,XDRHLP("F"))) Q:XDRHLP("F")'=+XDRHLP("F")  D

 ..W:XDRHLP("I") ! W ?40," ",$J($P(^AUTTLOC(XDRHLP("F"),0),U,7),4)," ",$P(^AUPNPAT(+$P(%,U,2),41,XDRHLP("F"),0),U,2),$S($P(^(0),U,3)="":"",1:"("_$P(^(0),U,5)_")")

 ..Q

 .K XDRHLP

 .Q

 W !

 Q

XDRHLP    ;IHS/LAB/OHPRD;help logic for selected fields in 15, 15.1; [ 10/20/92  11:01 AM ]

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

 +2       ;

 +3       ;this routine is called from files 15 and 15.1 and contains

 +4       ;executable help prompts

 +5       ;

 +6       ;no entry from top of routine, must use appropriate entry points

           QUIT 

 +7       ;

MD04      ;EP;called from .04 field of file 15, merge direction executable help

 +1        SET %=$PIECE(^VA(15,DA,0),U,1,2)

           WRITE !?5,"RECORD1=",$PIECE(@(U_$PIECE($PIECE(%,U,1),";",2)_+%_",0)"),U,1)

 +2        IF $GET(DUZ("AG"))="I"

               IF $PIECE($PIECE(%,U,1),";",2)="DPT("

                   Begin DoDot:1

 +3                    SET XDRHLP("F")=0

                       SET XDRHLP("I")=0

 +4                    FOR XDRHLP("I")=0:1

                           SET XDRHLP("F")=$ORDER(^AUPNPAT(+%,41,XDRHLP("F")))

                           IF XDRHLP("F")'=+XDRHLP("F")

                               QUIT 

                           Begin DoDot:2

 +5                            IF XDRHLP("I")

                                   WRITE !

                               WRITE ?40," ",$JUSTIFY($PIECE(^AUTTLOC(XDRHLP("F"),0),U,7),4)," ",$PIECE(^AUPNPAT(+%,41,XDRHLP("F"),0),U,2),$SELECT($PIECE(^(0),U,3)="":"",1:"("_$PIECE(^(0),U,5)_")")

 +6                            QUIT 

                           End DoDot:2

 +7                    KILL XDRHLP("F")

 +8                    QUIT 

                   End DoDot:1

 +9        WRITE !!,?5,"RECORD2=",$PIECE(@(U_$PIECE($PIECE(%,U,2),";",2)_+$PIECE(%,U,2)_",0)"),U,1)

 +10       IF $GET(DUZ("AG"))="I"

               IF $PIECE($PIECE(%,U,1),";",2)="DPT("

                   Begin DoDot:1

 +11                   SET XDRHLP("F")=0

                       SET XDRHLP("I")=0

 +12                   FOR XDRHLP("I")=0:1

                           SET XDRHLP("F")=$ORDER(^AUPNPAT(+$PIECE(%,U,2),41,XDRHLP("F")))

                           IF XDRHLP("F")'=+XDRHLP("F")

                               QUIT 

                           Begin DoDot:2

 +13                           IF XDRHLP("I")

                                   WRITE !

                               WRITE ?40," ",$JUSTIFY($PIECE(^AUTTLOC(XDRHLP("F"),0),U,7),4)," ",$PIECE(^AUPNPAT(+$PIECE(%,U,2),41,XDRHLP("F"),0),U,2),$SELECT($PIECE(^(0),U,3)="":"",1:"("_$PIECE(^(0),U,5)_")")

 +14                           QUIT 

                           End DoDot:2

 +15                   KILL XDRHLP

 +16                   QUIT 

                   End DoDot:1

 +17       WRITE !

 +18       QUIT