- 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 Feb 18, 2025@23:15:02 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 ;