ABSPOSC3 ; IHS/FCS/DRS - development - certification testing ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
RUNTEST(DIALOUT,FROM,THRU) ;EP - from ABSPOSC2,ABSPOSC4
I '$D(THRU) S THRU=FROM
K ^ABSPECX("POS",DIALOUT)
N I F I=FROM:1:THRU D
. N J S J=$P(^ABSPC(I,"M",0),U,3)
. S ^ABSPECX("POS",DIALOUT,"C",I,0)=J
. N K F K=1:1:J D
. . S ^ABSPECX("POS",DIALOUT,"C",I,K)=^ABSPC(I,"M",K,0)
D TASK^ABSPOSQ2 ; which should start up COMMS^ABSPOSQ3
Q
LASTCOMM ; print the last comms log - look backwards for the last .1 suffix
S X=9999999999
F S X=$O(^ABSPECP("LOG",X),-1) Q:'X Q:X#1=.1
W "Comms log ",X,! H 1
D PRINTLOG^ABSPOSL(X)
Q
RESTOR02 ; by sending ASCII file A:\ABSPEC02.GSA
N I,X,Y
K ^TMP($J) N DONE
W "SEND file A:\ABSPEC02.GSA in ASCII mode, you have 20 seconds:",!
F I=1:1 R ^TMP($J,I):20 Q:'$T
D CLR0203("YES")
;K ^ABSPC(*)
W !,"Now setting the data values...",!
F I=3:2 D Q:$G(DONE)
. S X=^TMP($J,I),Y=^TMP($J,I+1)
. I X="*",Y="*" S DONE=1 Q
. S @X=Y
W "We processed up through line number ",I-1,!
Q
CLR0203(X) ; erase all entries in 9002313.02 and .03 claims & responses
I X'="YES" D Q ; must pass this parameter to say you're really sure
. D IMPOSS^ABSPOSUE("P","TI","parameter X="_X,,"CLR0203",$T(+0))
N IEN,DA,DR,DIE,FILE
F FILE=9002313.02,9002313.03 DO CLR0203A(FILE)
Q
CLR0203A(FILE) I X'="YES" D Q
. D IMPOSS^ABSPOSUE("P","TI","parameter X="_X,,"CLR0203A",$T(+0))
N X,IEN,DIE,DA,DR
W "Erasing all entries in file ",FILE,"..."
S IEN=0 F S IEN=$O(^ABSP(FILE,IEN)) Q:'IEN D
. S DIE=FILE
. I DIE'=9002313.02,DIE'=9002313.03 D Q ; safety!
. . D IMPOSS^ABSPOSUE("P","TI","DIE="_DIE,,"CLR0203A",$T(+0))
. S DA=IEN,DR=".01///@"
. D ^DIE
. W:$X>70 !?5 W "."
W !
D ZWRITE^ABSPOS("IEN")
Q
ABSPOSC3 ; IHS/FCS/DRS - development - certification testing ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 QUIT
RUNTEST(DIALOUT,FROM,THRU) ;EP - from ABSPOSC2,ABSPOSC4
+1 IF '$DATA(THRU)
SET THRU=FROM
+2 KILL ^ABSPECX("POS",DIALOUT)
+3 NEW I
FOR I=FROM:1:THRU
Begin DoDot:1
+4 NEW J
SET J=$PIECE(^ABSPC(I,"M",0),U,3)
+5 SET ^ABSPECX("POS",DIALOUT,"C",I,0)=J
+6 NEW K
FOR K=1:1:J
Begin DoDot:2
+7 SET ^ABSPECX("POS",DIALOUT,"C",I,K)=^ABSPC(I,"M",K,0)
End DoDot:2
End DoDot:1
+8 ; which should start up COMMS^ABSPOSQ3
DO TASK^ABSPOSQ2
+9 QUIT
LASTCOMM ; print the last comms log - look backwards for the last .1 suffix
+1 SET X=9999999999
+2 FOR
SET X=$ORDER(^ABSPECP("LOG",X),-1)
IF 'X
QUIT
IF X#1=.1
QUIT
+3 WRITE "Comms log ",X,!
HANG 1
+4 DO PRINTLOG^ABSPOSL(X)
+5 QUIT
RESTOR02 ; by sending ASCII file A:\ABSPEC02.GSA
+1 NEW I,X,Y
+2 KILL ^TMP($JOB)
NEW DONE
+3 WRITE "SEND file A:\ABSPEC02.GSA in ASCII mode, you have 20 seconds:",!
+4 FOR I=1:1
READ ^TMP($JOB,I):20
IF '$TEST
QUIT
+5 DO CLR0203("YES")
+6 ;K ^ABSPC(*)
+7 WRITE !,"Now setting the data values...",!
+8 FOR I=3:2
Begin DoDot:1
+9 SET X=^TMP($JOB,I)
SET Y=^TMP($JOB,I+1)
+10 IF X="*"
IF Y="*"
SET DONE=1
QUIT
+11 SET @X=Y
End DoDot:1
IF $GET(DONE)
QUIT
+12 WRITE "We processed up through line number ",I-1,!
+13 QUIT
CLR0203(X) ; erase all entries in 9002313.02 and .03 claims & responses
+1 ; must pass this parameter to say you're really sure
IF X'="YES"
Begin DoDot:1
+2 DO IMPOSS^ABSPOSUE("P","TI","parameter X="_X,,"CLR0203",$TEXT(+0))
End DoDot:1
QUIT
+3 NEW IEN,DA,DR,DIE,FILE
+4 FOR FILE=9002313.02,9002313.03
DO CLR0203A(FILE)
+5 QUIT
CLR0203A(FILE) IF X'="YES"
Begin DoDot:1
+1 DO IMPOSS^ABSPOSUE("P","TI","parameter X="_X,,"CLR0203A",$TEXT(+0))
End DoDot:1
QUIT
+2 NEW X,IEN,DIE,DA,DR
+3 WRITE "Erasing all entries in file ",FILE,"..."
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ABSP(FILE,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 SET DIE=FILE
+6 ; safety!
IF DIE'=9002313.02
IF DIE'=9002313.03
Begin DoDot:2
+7 DO IMPOSS^ABSPOSUE("P","TI","DIE="_DIE,,"CLR0203A",$TEXT(+0))
End DoDot:2
QUIT
+8 SET DA=IEN
SET DR=".01///@"
+9 DO ^DIE
+10 IF $X>70
WRITE !?5
WRITE "."
End DoDot:1
+11 WRITE !
+12 DO ZWRITE^ABSPOS("IEN")
+13 QUIT
