- 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
