ABSPOSUB ; IHS/FCS/DRS - diagnostic data collection ; [ 09/12/2002 10:20 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
Q ; diagnostics data collection from full screen display
; You may need to rework this if/when it's ever needed to debug
; the user screen and the continuous update.
FILE(N) Q "/usr/spool/uucppublic/absbposm"_N_".tmp"
COMMON N %,%H,%I,X,NOW D NOW^%DTC
N NOW S NOW=%
S ^TMP("ABSP",$J,"ABSPOSUB","DATE CREATED")=NOW
M ^TMP("ABSP",$J,"ABSPOSUB","ABSPOSL")=^ABSPECP("LOG") ; too hard to separate by $J
M ^TMP("ABSP",$J,"ABSPOSUB",9002313.58)=^ABSPECX("S")
Q
INIT S ROU=$T(+0) K ^TMP("ABSP",$J,"ABSPOSUB") S ^TMP("ABSP",$J,"ABSPOSUB")=""
W "Collecting diagnostic data...",!
Q
BOTH ;EP - ABSPOS6K
W "Doing first part...",! D FULL
W "Doing second part...",! D JOB
W "Both parts done.",!
Q
FULL ;EP - ABSPOS6K
N ROU D INIT
S ^TMP("ABSP",$J,"ABSPOSUB")="Created by FULL^"_$T(+0)
D COMMON
M ^TMP("ABSP",$J,"ABSPOSUB","ABSPOS")=^TMP("ABSPOS")
M ^TMP("ABSP",$J,"ABSPOSUB","ABSPOSUA")=^TMP("ABSPOSUA")
; take the last hundred ^ABSPC( and associated responses
D LAST0203(100)
D LAST59(100)
W "Writing file ",$$FILE(1),"...",!
D GS(1)
W "Done.",!
Q
JOB ;EP - ABSPOS6K
D INIT
S ^TMP("ABSP",$J,"ABSPOSUB")="Created by JOB^"_$T(+0)_" for $JOB="_$J
D COMMON
M ^TMP("ABSP",$J,"ABSPOSUB","ABSPOS",$J)=^TMP("ABSPOS",$J)
M ^TMP("ABSP",$J,"ABSPOSUB","ABSPOSUA",$J)=^TMP("ABSPOSUA",$J)
D LISTMGR
D LAST0203(10)
D LAST59(10)
W "Writing file ",$$FILE(2),"...",!
D GS(2)
W "Done.",!
Q
LISTMGR ; List Manager data
F X="VALMCNT","VALMBG","VALMAR" D
. I $D(@X) S ^TMP("ABSP",$J,"ABSPOSUB",X)=@X
M ^TMP("ABSP",$J,"ABSPOSUB","VALMAR")=@VALMAR
Q
LAST59(N) ; last N 9002313.59 entries
N X S X="A"
N J F J=1:1:100 S X=$O(^ABSPT(X),-1) Q:'X D
.M ^TMP("ABSP",$J,"ABSPOSUB","9002313.59",X)=^ABSPT(X)
Q
LAST0203(N) ; last N 9002313.02 entries and associated 9002313.03's.
N X S X=$P(^ABSPC(0),"^",3)
N CLAIM,RESP F CLAIM=X:-1:X-N+1 D
.M ^TMP("ABSP",$J,"ABSPOSUB","CLAIM",CLAIM)=^ABSPC(CLAIM)
.S RESP="" F S RESP=$O(^ABSPR("B",CLAIM,RESP)) Q:'RESP D
..M ^TMP("ABSP",$J,"ABSPOSUB","RESP",RESP)=^ABSPR(RESP)
Q
GS(TYPE) ; write file in ^%GS format
; TYPE = 1 - from the FULL option
; TYPE = 2 - from the JOB option
N FILE,R,R0
S FILE=$$FILE(TYPE)
D IMPOSS^ABSPOSUE("P","TI","routine still in development",,"GS",$T(+0))
; O 51:(FILE:"W")
;U 51 W $T(+1),!,$G(NOW)_" "_$H,!
S R="^TMP(""ABSP"","_$J_",""_ROU_"")"
S R0=$E(R,1,$L(R)-1)
F D Q:$E(R,1,$L(R0))'=R0
. W R,!,@R,!
. S R=$Q(@R)
W "*",!,"*",!,"**",!,"**",!
;C 51
Q
ABSPOSUB ; IHS/FCS/DRS - diagnostic data collection ; [ 09/12/2002 10:20 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ; diagnostics data collection from full screen display
QUIT
+3 ; You may need to rework this if/when it's ever needed to debug
+4 ; the user screen and the continuous update.
FILE(N) QUIT "/usr/spool/uucppublic/absbposm"_N_".tmp"
COMMON NEW %,%H,%I,X,NOW
DO NOW^%DTC
+1 NEW NOW
SET NOW=%
+2 SET ^TMP("ABSP",$JOB,"ABSPOSUB","DATE CREATED")=NOW
+3 ; too hard to separate by $J
MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","ABSPOSL")=^ABSPECP("LOG")
+4 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB",9002313.58)=^ABSPECX("S")
+5 QUIT
INIT SET ROU=$TEXT(+0)
KILL ^TMP("ABSP",$JOB,"ABSPOSUB")
SET ^TMP("ABSP",$JOB,"ABSPOSUB")=""
+1 WRITE "Collecting diagnostic data...",!
+2 QUIT
BOTH ;EP - ABSPOS6K
+1 WRITE "Doing first part...",!
DO FULL
+2 WRITE "Doing second part...",!
DO JOB
+3 WRITE "Both parts done.",!
+4 QUIT
FULL ;EP - ABSPOS6K
+1 NEW ROU
DO INIT
+2 SET ^TMP("ABSP",$JOB,"ABSPOSUB")="Created by FULL^"_$TEXT(+0)
+3 DO COMMON
+4 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","ABSPOS")=^TMP("ABSPOS")
+5 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","ABSPOSUA")=^TMP("ABSPOSUA")
+6 ; take the last hundred ^ABSPC( and associated responses
+7 DO LAST0203(100)
+8 DO LAST59(100)
+9 WRITE "Writing file ",$$FILE(1),"...",!
+10 DO GS(1)
+11 WRITE "Done.",!
+12 QUIT
JOB ;EP - ABSPOS6K
+1 DO INIT
+2 SET ^TMP("ABSP",$JOB">JOB">JOB">JOB,"ABSPOSUB")="Created by JOB">JOB">JOB">JOB^"_$TEXT(+0)_" for $JOB">JOB">JOB">JOB="_$JOB">JOB">JOB">JOB
+3 DO COMMON
+4 MERGE ^TMP("ABSP",$JOB">JOB">JOB">JOB,"ABSPOSUB","ABSPOS",$JOB">JOB">JOB">JOB)=^TMP("ABSPOS",$JOB">JOB">JOB">JOB)
+5 MERGE ^TMP("ABSP",$JOB">JOB">JOB">JOB,"ABSPOSUB","ABSPOSUA",$JOB">JOB">JOB">JOB)=^TMP("ABSPOSUA",$JOB">JOB">JOB">JOB)
+6 DO LISTMGR
+7 DO LAST0203(10)
+8 DO LAST59(10)
+9 WRITE "Writing file ",$$FILE(2),"...",!
+10 DO GS(2)
+11 WRITE "Done.",!
+12 QUIT
LISTMGR ; List Manager data
+1 FOR X="VALMCNT","VALMBG","VALMAR"
Begin DoDot:1
+2 IF $DATA(@X)
SET ^TMP("ABSP",$JOB,"ABSPOSUB",X)=@X
End DoDot:1
+3 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","VALMAR")=@VALMAR
+4 QUIT
LAST59(N) ; last N 9002313.59 entries
+1 NEW X
SET X="A"
+2 NEW J
FOR J=1:1:100
SET X=$ORDER(^ABSPT(X),-1)
IF 'X
QUIT
Begin DoDot:1
+3 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","9002313.59",X)=^ABSPT(X)
End DoDot:1
+4 QUIT
LAST0203(N) ; last N 9002313.02 entries and associated 9002313.03's.
+1 NEW X
SET X=$PIECE(^ABSPC(0),"^",3)
+2 NEW CLAIM,RESP
FOR CLAIM=X:-1:X-N+1
Begin DoDot:1
+3 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","CLAIM",CLAIM)=^ABSPC(CLAIM)
+4 SET RESP=""
FOR
SET RESP=$ORDER(^ABSPR("B",CLAIM,RESP))
IF 'RESP
QUIT
Begin DoDot:2
+5 MERGE ^TMP("ABSP",$JOB,"ABSPOSUB","RESP",RESP)=^ABSPR(RESP)
End DoDot:2
End DoDot:1
+6 QUIT
GS(TYPE) ; write file in ^%GS format
+1 ; TYPE = 1 - from the FULL option
+2 ; TYPE = 2 - from the JOB option
+3 NEW FILE,R,R0
+4 SET FILE=$$FILE(TYPE)
+5 DO IMPOSS^ABSPOSUE("P","TI","routine still in development",,"GS",$TEXT(+0))
+6 ; O 51:(FILE:"W")
+7 ;U 51 W $T(+1),!,$G(NOW)_" "_$H,!
+8 SET R="^TMP(""ABSP"","_$JOB_",""_ROU_"")"
+9 SET R0=$EXTRACT(R,1,$LENGTH(R)-1)
+10 FOR
Begin DoDot:1
+11 WRITE R,!,@R,!
+12 SET R=$QUERY(@R)
End DoDot:1
IF $EXTRACT(R,1,$LENGTH(R0))'=R0
QUIT
+13 WRITE "*",!,"*",!,"**",!,"**",!
+14 ;C 51
+15 QUIT
