PXRMPTD1 ;SLC/PKR,PJH,AGP - Reminder Inquiry print template routines. ;04/05/2016 12:06
;;2.0;CLINICAL REMINDERS;**4,12,22,45**;Feb 04, 2005;Build 566
;
;=======================================
AFREQ ; Print baseline FREQUENCY/AGE RANGE.
N PXAMAX,PXAMIN,PXF,PXF0,PXW
S PXF0=$G(^PXD(811.9,D0,7,D1,0))
S PXF=$P(PXF0,U,1)
S PXAMIN=$P(PXF0,U,2)
S PXAMAX=$P(PXF0,U,3)
I PXF="" S PXW="MISSING FREQUENCY"
S PXW=$$FREQ^PXRMPTD2(PXF)
S PXW=PXW_$$FMTAGE^PXRMAGE(PXAMIN,PXAMAX)
W " ",PXW
Q
;
;=======================================
DUEWI ;Print DO WITHIN time frame
N PXF,PXW
S PXF=$P($G(^PXD(811.9,D0,0)),U,4)
I (PXF="")!(+PXF=0) W " Wait until actually DUE" Q
S PXW=$$FREQ^PXRMPTD2(PXF)
W " Do if DUE within "_PXW
Q
;
;=======================================
EDIT ;Print latest entry in edit history
N CNT,DIWF,DIWL,DIWR,EDATA,EIEN,ETIME,FIRST,IC,MAX,UIEN,USER,X
K ^UTILITY($J,"W")
;Get edit history count
S MAX=$G(^PXRM(800,1,"EDIT HISTORY COUNT")) I MAX="" S MAX=2
;Last N lines
S CNT=0,EIEN="A",FIRST=1
F S EIEN=$O(^PXD(811.9,D0,110,EIEN),-1) Q:'EIEN Q:CNT=MAX D
.;Edit date and edit by fields
.S EDATA=$G(^PXD(811.9,D0,110,EIEN,0)) Q:EDATA=""
.S ETIME=$P(EDATA,U),UIEN=$P(EDATA,U,2) Q:'UIEN
.S USER=$$GET1^DIQ(200,UIEN,.01),CNT=CNT+1
.;Comments
.S DIWF="C50",DIWL=20,DIWR=78
.S IC=0
.F S IC=$O(^PXD(811.9,D0,110,EIEN,1,IC)) Q:'IC D
..S X=$G(^PXD(811.9,D0,110,EIEN,1,IC,0))
..D ^DIWP
.;Output
.;Header
.I FIRST S FIRST=0 W "Edit History:",!!
.W ?4,"Edit date:",?16,$$FMTE^XLFDT(ETIME,"1")
.W ?40,"Edit by:",?52,USER
.W !,?4,"Edit Comments:"
.S IC=0
.F S IC=$O(^UTILITY($J,"W",DIWL,IC)) Q:IC="" D
..W ?20,^UTILITY($J,"W",DIWL,IC,0),!
.K ^UTILITY($J,"W")
.W !!
Q
;
;=======================================
USAGE ;Format usage string
W ?7,$$XFORM($P($G(^PXD(811.9,D0,100)),U,4))
Q
;
;=======================================
XFORM(Y) ;Print transform for field 103 in file #811.9
;If ALL
N ARRAY,IC,LIT,OUTPUT,X
I Y["*" D
. S ARRAY("CPRS")=""
. S ARRAY("DATA EXTRACT")=""
. S ARRAY("REPORTS")=""
;Look for others.
F IC=1:1:$L(Y) D
. S X=$E(Y,IC)
. I X="*" Q
. S LIT=$S(X="C":"CPRS",X="X":"DATA EXTRACT",X="R":"REPORTS",X="P":"PATIENT",X="L":"REMINDER PATIENT LIST",X="O":"REMINDER ORDER CHECKS",X="A":"ACTION",1:"")
. I LIT'="" S ARRAY(LIT)=""
;
S LIT="",OUTPUT=""
F S LIT=$O(ARRAY(LIT)) Q:LIT="" D
. S OUTPUT=OUTPUT_", "_LIT
Q $E(OUTPUT,3,$L(OUTPUT))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPTD1 2516 printed Apr 09, 2024@20:51:22 Page 2
PXRMPTD1 ;SLC/PKR,PJH,AGP - Reminder Inquiry print template routines. ;04/05/2016 12:06
+1 ;;2.0;CLINICAL REMINDERS;**4,12,22,45**;Feb 04, 2005;Build 566
+2 ;
+3 ;=======================================
AFREQ ; Print baseline FREQUENCY/AGE RANGE.
+1 NEW PXAMAX,PXAMIN,PXF,PXF0,PXW
+2 SET PXF0=$GET(^PXD(811.9,D0,7,D1,0))
+3 SET PXF=$PIECE(PXF0,U,1)
+4 SET PXAMIN=$PIECE(PXF0,U,2)
+5 SET PXAMAX=$PIECE(PXF0,U,3)
+6 IF PXF=""
SET PXW="MISSING FREQUENCY"
+7 SET PXW=$$FREQ^PXRMPTD2(PXF)
+8 SET PXW=PXW_$$FMTAGE^PXRMAGE(PXAMIN,PXAMAX)
+9 WRITE " ",PXW
+10 QUIT
+11 ;
+12 ;=======================================
DUEWI ;Print DO WITHIN time frame
+1 NEW PXF,PXW
+2 SET PXF=$PIECE($GET(^PXD(811.9,D0,0)),U,4)
+3 IF (PXF="")!(+PXF=0)
WRITE " Wait until actually DUE"
QUIT
+4 SET PXW=$$FREQ^PXRMPTD2(PXF)
+5 WRITE " Do if DUE within "_PXW
+6 QUIT
+7 ;
+8 ;=======================================
EDIT ;Print latest entry in edit history
+1 NEW CNT,DIWF,DIWL,DIWR,EDATA,EIEN,ETIME,FIRST,IC,MAX,UIEN,USER,X
+2 KILL ^UTILITY($JOB,"W")
+3 ;Get edit history count
+4 SET MAX=$GET(^PXRM(800,1,"EDIT HISTORY COUNT"))
IF MAX=""
SET MAX=2
+5 ;Last N lines
+6 SET CNT=0
SET EIEN="A"
SET FIRST=1
+7 FOR
SET EIEN=$ORDER(^PXD(811.9,D0,110,EIEN),-1)
if 'EIEN
QUIT
if CNT=MAX
QUIT
Begin DoDot:1
+8 ;Edit date and edit by fields
+9 SET EDATA=$GET(^PXD(811.9,D0,110,EIEN,0))
if EDATA=""
QUIT
+10 SET ETIME=$PIECE(EDATA,U)
SET UIEN=$PIECE(EDATA,U,2)
if 'UIEN
QUIT
+11 SET USER=$$GET1^DIQ(200,UIEN,.01)
SET CNT=CNT+1
+12 ;Comments
+13 SET DIWF="C50"
SET DIWL=20
SET DIWR=78
+14 SET IC=0
+15 FOR
SET IC=$ORDER(^PXD(811.9,D0,110,EIEN,1,IC))
if 'IC
QUIT
Begin DoDot:2
+16 SET X=$GET(^PXD(811.9,D0,110,EIEN,1,IC,0))
+17 DO ^DIWP
End DoDot:2
+18 ;Output
+19 ;Header
+20 IF FIRST
SET FIRST=0
WRITE "Edit History:",!!
+21 WRITE ?4,"Edit date:",?16,$$FMTE^XLFDT(ETIME,"1")
+22 WRITE ?40,"Edit by:",?52,USER
+23 WRITE !,?4,"Edit Comments:"
+24 SET IC=0
+25 FOR
SET IC=$ORDER(^UTILITY($JOB,"W",DIWL,IC))
if IC=""
QUIT
Begin DoDot:2
+26 WRITE ?20,^UTILITY($JOB,"W",DIWL,IC,0),!
End DoDot:2
+27 KILL ^UTILITY($JOB,"W")
+28 WRITE !!
End DoDot:1
+29 QUIT
+30 ;
+31 ;=======================================
USAGE ;Format usage string
+1 WRITE ?7,$$XFORM($PIECE($GET(^PXD(811.9,D0,100)),U,4))
+2 QUIT
+3 ;
+4 ;=======================================
XFORM(Y) ;Print transform for field 103 in file #811.9
+1 ;If ALL
+2 NEW ARRAY,IC,LIT,OUTPUT,X
+3 IF Y["*"
Begin DoDot:1
+4 SET ARRAY("CPRS")=""
+5 SET ARRAY("DATA EXTRACT")=""
+6 SET ARRAY("REPORTS")=""
End DoDot:1
+7 ;Look for others.
+8 FOR IC=1:1:$LENGTH(Y)
Begin DoDot:1
+9 SET X=$EXTRACT(Y,IC)
+10 IF X="*"
QUIT
+11 SET LIT=$SELECT(X="C":"CPRS",X="X":"DATA EXTRACT",X="R":"REPORTS",X="P":"PATIENT",X="L":"REMINDER PATIENT LIST",X="O":"REMINDER ORDER CHECKS",X="A":"ACTION",1:"")
+12 IF LIT'=""
SET ARRAY(LIT)=""
End DoDot:1
+13 ;
+14 SET LIT=""
SET OUTPUT=""
+15 FOR
SET LIT=$ORDER(ARRAY(LIT))
if LIT=""
QUIT
Begin DoDot:1
+16 SET OUTPUT=OUTPUT_", "_LIT
End DoDot:1
+17 QUIT $EXTRACT(OUTPUT,3,$LENGTH(OUTPUT))
+18 ;
