PXRMETH1 ; SLC/PJH - Reminder Extract History ;09/07/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
BLDLIST(EDIEN) ;Build workfile
;EDIEN is the extract definition IEN.
N IND,FMTSTR,PLIST
K ^TMP("PXRMETH",$J)
S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLL")
;Build list of extract summaries in period order
I PXRMVIEW="P" D LIST1(EDIEN,"PXRMETH",FMTSTR)
;Build list of extract summaries in date order
I PXRMVIEW="D" D LIST2(EDIEN,"PXRMETH",FMTSTR)
Q
;
FMT(NUMBER,NAME,EDATE,XDATE,AUTO,FMTSTR,NL,OUTPUT) ;Format
N TAUTO,TDATE,TEMP,TNAME,TSOURCE
S TEMP=NUMBER_U_NAME_U
S TDATE=$$FMTE^XLFDT(EDATE,"5Z")
S TEMP=TEMP_$$LJ^XLFSTR(TDATE,20," ")
S TDATE=XDATE I TDATE S TDATE=$$FMTE^XLFDT(TDATE,"5Z")
S TEMP=TEMP_" "_$$LJ^XLFSTR(TDATE,22," ")
S TAUTO=AUTO
S TEMP=TEMP_TAUTO
D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
Q
;
HELP(CALL) ;General help text routine.
N HTEXT
I CALL=1 D
.S HTEXT(1)="Select DE to delete an extract.\\"
.S HTEXT(2)="Select ES to view the details of an extract or run a compliance"
.S HTEXT(3)="report for the extract.\\Select MT to transmit extract details to the AAC.\\"
.S HTEXT(4)="Select TH to view the transmission history for an extract."
;
I CALL=3 D
.S HTEXT(1)="Select Y to send the results of the Extract to the National Austin database."
;
I CALL=4 D
.S HTEXT(4)="Select Y to overwrite the previous Extract stored in the National Austin Database."
D HELP^PXRMEUT(.HTEXT)
Q
;
LIST1(EDIEN,NODE,FMTSTR) ;Build a list of extract summaries for a parameter.
N AUTO,EDATE,HL7ID,HL7SUB,IND,JND,NAME,NL,NUM,OUTPUT
N PERIOD,STR,XDATE,YEAR
;Build list of extract summaries in reverse date order.
S YEAR="9999",(NUM,VALMCNT)=0
F S YEAR=$O(^PXRMXT(810.3,"D",EDIEN,YEAR),-1) Q:YEAR="" D
.S PERIOD="99"
.F S PERIOD=$O(^PXRMXT(810.3,"D",EDIEN,YEAR,PERIOD),-1) Q:PERIOD="" D
..S IND=""
..F S IND=$O(^PXRMXT(810.3,"D",EDIEN,YEAR,PERIOD,IND),-1) Q:IND="" D
...S NAME=$P($G(^PXRMXT(810.3,IND,0)),U)
...S EDATE=$P($G(^PXRMXT(810.3,IND,0)),U,6)
...S AUTO=$P($G(^PXRMXT(810.3,IND,4)),U,5)
...S AUTO=$S(AUTO="A":"Y",1:"N")
...S HL7ID=$O(^PXRMXT(810.3,IND,5,"B",""),-1),XDATE="",HL7SUB=""
...I HL7ID S HL7SUB=$O(^PXRMXT(810.3,IND,5,"B",HL7ID,""))
...I HL7SUB S XDATE=$P($G(^PXRMXT(810.3,IND,5,HL7SUB,0)),U,2)
...I 'XDATE S XDATE="Not Transmitted"
...S NUM=NUM+1
...D FMT(NUM,NAME,EDATE,XDATE,AUTO,FMTSTR,.NL,.OUTPUT)
...F JND=1:1:NL D
....S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(JND)
....S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""
....S ^TMP(NODE,$J,"SEL",NUM)=IND
Q
;
LIST2(EDIEN,NODE,FMTSTR) ;Build a list of extract summaries for a parameter.
N AUTO,EDATE,HL7ID,HL7SUB,IND,JND,NAME,NL,NUM,OUTPUT
N PERIOD,STR,XDATE,YEAR
;Build list of extract summaries in reverse date order.
S EDATE="",(NUM,VALMCNT)=0
F S EDATE=$O(^PXRMXT(810.3,"C",EDIEN,EDATE),-1) Q:'EDATE D
.S IND=""
.F S IND=$O(^PXRMXT(810.3,"C",EDIEN,EDATE,IND)) Q:'IND D
..S NAME=$P($G(^PXRMXT(810.3,IND,0)),U,1)
..S AUTO=$P($G(^PXRMXT(810.3,IND,4)),U,5)
..S AUTO=$S(AUTO="A":"Y",1:"N")
..S HL7ID=$O(^PXRMXT(810.3,IND,5,"B",""),-1),XDATE="",HL7SUB=""
..I HL7ID S HL7SUB=$O(^PXRMXT(810.3,IND,5,"B",HL7ID,""))
..I HL7SUB S XDATE=$P($G(^PXRMXT(810.3,IND,5,HL7SUB,0)),U,2)
..I 'XDATE S XDATE="Not Transmitted"
..S NUM=NUM+1
..D FMT(NUM,NAME,EDATE,XDATE,AUTO,FMTSTR,.NL,.OUTPUT)
..F JND=1:1:NL D
...S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(JND)
...S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""
...S ^TMP(NODE,$J,"SEL",NUM)=IND
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMETH1 3597 printed Apr 09, 2024@20:48:26 Page 2
PXRMETH1 ; SLC/PJH - Reminder Extract History ;09/07/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
BLDLIST(EDIEN) ;Build workfile
+1 ;EDIEN is the extract definition IEN.
+2 NEW IND,FMTSTR,PLIST
+3 KILL ^TMP("PXRMETH",$JOB)
+4 SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLL")
+5 ;Build list of extract summaries in period order
+6 IF PXRMVIEW="P"
DO LIST1(EDIEN,"PXRMETH",FMTSTR)
+7 ;Build list of extract summaries in date order
+8 IF PXRMVIEW="D"
DO LIST2(EDIEN,"PXRMETH",FMTSTR)
+9 QUIT
+10 ;
FMT(NUMBER,NAME,EDATE,XDATE,AUTO,FMTSTR,NL,OUTPUT) ;Format
+1 NEW TAUTO,TDATE,TEMP,TNAME,TSOURCE
+2 SET TEMP=NUMBER_U_NAME_U
+3 SET TDATE=$$FMTE^XLFDT(EDATE,"5Z")
+4 SET TEMP=TEMP_$$LJ^XLFSTR(TDATE,20," ")
+5 SET TDATE=XDATE
IF TDATE
SET TDATE=$$FMTE^XLFDT(TDATE,"5Z")
+6 SET TEMP=TEMP_" "_$$LJ^XLFSTR(TDATE,22," ")
+7 SET TAUTO=AUTO
+8 SET TEMP=TEMP_TAUTO
+9 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
+10 QUIT
+11 ;
HELP(CALL) ;General help text routine.
+1 NEW HTEXT
+2 IF CALL=1
Begin DoDot:1
+3 SET HTEXT(1)="Select DE to delete an extract.\\"
+4 SET HTEXT(2)="Select ES to view the details of an extract or run a compliance"
+5 SET HTEXT(3)="report for the extract.\\Select MT to transmit extract details to the AAC.\\"
+6 SET HTEXT(4)="Select TH to view the transmission history for an extract."
End DoDot:1
+7 ;
+8 IF CALL=3
Begin DoDot:1
+9 SET HTEXT(1)="Select Y to send the results of the Extract to the National Austin database."
End DoDot:1
+10 ;
+11 IF CALL=4
Begin DoDot:1
+12 SET HTEXT(4)="Select Y to overwrite the previous Extract stored in the National Austin Database."
End DoDot:1
+13 DO HELP^PXRMEUT(.HTEXT)
+14 QUIT
+15 ;
LIST1(EDIEN,NODE,FMTSTR) ;Build a list of extract summaries for a parameter.
+1 NEW AUTO,EDATE,HL7ID,HL7SUB,IND,JND,NAME,NL,NUM,OUTPUT
+2 NEW PERIOD,STR,XDATE,YEAR
+3 ;Build list of extract summaries in reverse date order.
+4 SET YEAR="9999"
SET (NUM,VALMCNT)=0
+5 FOR
SET YEAR=$ORDER(^PXRMXT(810.3,"D",EDIEN,YEAR),-1)
if YEAR=""
QUIT
Begin DoDot:1
+6 SET PERIOD="99"
+7 FOR
SET PERIOD=$ORDER(^PXRMXT(810.3,"D",EDIEN,YEAR,PERIOD),-1)
if PERIOD=""
QUIT
Begin DoDot:2
+8 SET IND=""
+9 FOR
SET IND=$ORDER(^PXRMXT(810.3,"D",EDIEN,YEAR,PERIOD,IND),-1)
if IND=""
QUIT
Begin DoDot:3
+10 SET NAME=$PIECE($GET(^PXRMXT(810.3,IND,0)),U)
+11 SET EDATE=$PIECE($GET(^PXRMXT(810.3,IND,0)),U,6)
+12 SET AUTO=$PIECE($GET(^PXRMXT(810.3,IND,4)),U,5)
+13 SET AUTO=$SELECT(AUTO="A":"Y",1:"N")
+14 SET HL7ID=$ORDER(^PXRMXT(810.3,IND,5,"B",""),-1)
SET XDATE=""
SET HL7SUB=""
+15 IF HL7ID
SET HL7SUB=$ORDER(^PXRMXT(810.3,IND,5,"B",HL7ID,""))
+16 IF HL7SUB
SET XDATE=$PIECE($GET(^PXRMXT(810.3,IND,5,HL7SUB,0)),U,2)
+17 IF 'XDATE
SET XDATE="Not Transmitted"
+18 SET NUM=NUM+1
+19 DO FMT(NUM,NAME,EDATE,XDATE,AUTO,FMTSTR,.NL,.OUTPUT)
+20 FOR JND=1:1:NL
Begin DoDot:4
+21 SET VALMCNT=VALMCNT+1
SET ^TMP(NODE,$JOB,VALMCNT,0)=OUTPUT(JND)
+22 SET ^TMP(NODE,$JOB,"IDX",VALMCNT,NUM)=""
+23 SET ^TMP(NODE,$JOB,"SEL",NUM)=IND
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
LIST2(EDIEN,NODE,FMTSTR) ;Build a list of extract summaries for a parameter.
+1 NEW AUTO,EDATE,HL7ID,HL7SUB,IND,JND,NAME,NL,NUM,OUTPUT
+2 NEW PERIOD,STR,XDATE,YEAR
+3 ;Build list of extract summaries in reverse date order.
+4 SET EDATE=""
SET (NUM,VALMCNT)=0
+5 FOR
SET EDATE=$ORDER(^PXRMXT(810.3,"C",EDIEN,EDATE),-1)
if 'EDATE
QUIT
Begin DoDot:1
+6 SET IND=""
+7 FOR
SET IND=$ORDER(^PXRMXT(810.3,"C",EDIEN,EDATE,IND))
if 'IND
QUIT
Begin DoDot:2
+8 SET NAME=$PIECE($GET(^PXRMXT(810.3,IND,0)),U,1)
+9 SET AUTO=$PIECE($GET(^PXRMXT(810.3,IND,4)),U,5)
+10 SET AUTO=$SELECT(AUTO="A":"Y",1:"N")
+11 SET HL7ID=$ORDER(^PXRMXT(810.3,IND,5,"B",""),-1)
SET XDATE=""
SET HL7SUB=""
+12 IF HL7ID
SET HL7SUB=$ORDER(^PXRMXT(810.3,IND,5,"B",HL7ID,""))
+13 IF HL7SUB
SET XDATE=$PIECE($GET(^PXRMXT(810.3,IND,5,HL7SUB,0)),U,2)
+14 IF 'XDATE
SET XDATE="Not Transmitted"
+15 SET NUM=NUM+1
+16 DO FMT(NUM,NAME,EDATE,XDATE,AUTO,FMTSTR,.NL,.OUTPUT)
+17 FOR JND=1:1:NL
Begin DoDot:3
+18 SET VALMCNT=VALMCNT+1
SET ^TMP(NODE,$JOB,VALMCNT,0)=OUTPUT(JND)
+19 SET ^TMP(NODE,$JOB,"IDX",VALMCNT,NUM)=""
+20 SET ^TMP(NODE,$JOB,"SEL",NUM)=IND
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
