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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRHLP 1280 printed Dec 13, 2024@02:39:23 Page 2
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
