Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMDGFC

PXRMDGFC.m

Go to the documentation of this file. 
  1. PXRMDGFC ;SLC/AGP - Reminder General Finding Checker;04/13/2021
  1.  ;;2.0;CLINICAL REMINDERS;**71**;Feb 04, 2005;Build 43
  1.  ;
  1.  ;SACC EXEMPTIONS SECTION
  1.  ;2.3.1.10.1 and 2.3.1.10.2
  1.  ;
  1. ALL ;
  1.  N IEN
  1.  S IEN=0 F  S IEN=$O(^PXRMD(801.46,IEN)) Q:IEN'>0  D
  1.  .D GFENT(IEN)
  1.  W !!,"  Done"
  1.  Q
  1.  ;
  1. BLDSET(SET,OUTPUT) ;
  1.  N CNT,PIECE,STR
  1.  S PIECE=0
  1.  F CNT=1:1:$L(SET) I $E(SET,CNT)=";" S PIECE=PIECE+1 I PIECE>0 D
  1.  . S STR=$P($G(SET),";",PIECE)
  1.  . S OUTPUT($$UP^XLFSTR($P(STR,":")))=""
  1.  . S OUTPUT($$UP^XLFSTR($P(STR,":",2)))=""
  1.  Q
  1.  ;
  1. EN ;
  1.  N ARRAY,DARRAY,DCNT,DIEN
  1.  S DIEN=$$SELECT()
  1.  I DIEN=-1 Q
  1.  S DCNT=0
  1.  W !,"Checking dialog: "_$P(DIEN,U,2)
  1.  D DITEMAR^PXRMDUTL(+DIEN,.ARRAY,.DARRAY,.DCNT)
  1.  D PROCESS(.DARRAY)
  1.  W !,"  Done"
  1.  Q
  1.  ;
  1. GETFINDS(FINDINGS,DIEN) ;
  1.  N FIND
  1.  I $P($G(^PXRMD(801.41,DIEN,1)),U,5)'="" S FINDINGS($P(^PXRMD(801.41,DIEN,1),U,5))=""
  1.  S FIND="" F  S FIND=$O(^PXRMD(801.41,DIEN,3,"B",FIND)) Q:FIND=""  D
  1.  .S FINDINGS(FIND)=""
  1.  Q
  1.  ;
  1. GFENT(IEN) ;
  1.  N FILENUM,FIELD,NAME,PKG,RESULT,VALUE,X0,X1,X2,X3
  1.  S X0=$G(^PXRMD(801.46,IEN,0))
  1.  S NAME=$P(X0,U)
  1.  S PKG=$P(X0,U,2),FILENUM=$P(X0,U,3)
  1.  I +PKG=0 S RESULT=-1 G GFENTX
  1.  I FILENUM="" S RESULT=-1 G GFENTX
  1.  I FILENUM=100.9 Q
  1.  S X1=$G(^PXRMD(801.46,IEN,1))
  1.  S X2=$G(^PXRMD(801.46,IEN,2))
  1.  S X3=$G(^PXRMD(801.46,IEN,3))
  1.  S VALUE=$P(X1,U)
  1.  S FIELD=$P(X1,U,2)
  1.  I VALUE="" D  G GFENTX
  1.  .I NAME="WV DIAGNOSIS" S RESULT=1 Q
  1.  .I $P(X2,U)'="" S RESULT=1 Q
  1.  .I $P(X3,U,3)=1 S RESULT=1 Q
  1.  .S RESULT=-1
  1.  I +FIELD=0 D  G GFENTX
  1.  .I $P(X2,U,2)'="" S RESULT=1 Q
  1.  .I FIELD'="" S RESULT=1 Q
  1.  .S RESULT=-1
  1.  ;if used for IEN prompt it is valid
  1.  I FIELD=.01,VALUE="",$P(X3,U,3)=1 S RESULT=1 G GFENTX
  1.  ;used as a placeholder to insert the patient DFN
  1.  I VALUE="PATIENT" S RESULT=1 G GFENTX
  1.  ;used to delete values out of file 790
  1.  I FILENUM=790&(VALUE="DELETE")&(FIELD=.18!(FIELD=.19)) S RESULT=1 G GFENTX
  1.  ;used to set patient next due date based off the patient age
  1.  I FILENUM=790,VALUE="AGE",FIELD=.19 S RESULT=1 G GFENTX
  1.  ;used to delete values out of pregnancy/lactation log
  1.  I FILENUM=790.9&(FIELD=.01)&(VALUE["P"!(VALUE["L")) S RESULT=1 G GFENTX
  1.  ;all other validation
  1.  S RESULT=$$VALIDATE(IEN,FILENUM,FIELD,VALUE)
  1. GFENTX ;
  1.  I RESULT=-1 W !,IEN_": "_NAME_" not setup correctly"
  1.  I RESULT=0 W !,IEN_": "_NAME_" failed validation"
  1.  Q 
  1.  ;
  1. PROCESS(DARRAY) ;
  1.  N DIEN,FIND,FINDINGS
  1.  S DIEN=0 F  S DIEN=$O(DARRAY(DIEN)) Q:DIEN'>0  D
  1.  .K FINDINGS
  1.  .D GETFINDS(.FINDINGS,DIEN)
  1.  .S FIND="" F  S FIND=$O(FINDINGS(FIND)) Q:FIND=""  D
  1.  ..I FIND["PXRMD(801.46" D GFENT(+FIND)
  1.  Q
  1.  ;
  1. SELECT() ;
  1.  N DIC,DTOUT,DUOUT,Y
  1.  S DIC="^PXRMD(801.41,"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select Reminder Dialog Item: "
  1.  S DIC("S")="I $P(^PXRMD(801.41,Y,0),U,4)=""R"""
  1.  D ^DIC
  1.  I $D(DTOUT)!($D(DUOUT)) S Y=-1
  1.  Q Y
  1.  ;
  1. VALIDATE(IEN,FILENUM,FIELD,VALUE) ;
  1.  N ATTR,CODE,MSG,PFILE,RESULT,SETS,TYPE,X
  1.  S RESULT=1
  1.  S TYPE="FIELD LENGTH;INPUT TRANSFORM;POINTER;SPECIFIER;TYPE"
  1.  D FIELD^DID(FILENUM,FIELD,"",TYPE,"ATTR","MSG")
  1.  I $D(MSG) W !,"IEN: "_IEN D AWRITE^PXRMUTIL("MSG") Q RESULT
  1.  ;pointer
  1.  I ATTR("TYPE")="POINTER" D  Q RESULT
  1.  .S PFILE=+$P(ATTR("SPECIFIER"),"P",2)
  1.  .;I PFILE=790.404,VALUE'="",+VALUE=0 Q
  1.  .I '$$EXISTS^PXRMEXIU(PFILE,VALUE) S RESULT=0
  1.  ;set of code
  1.  I ATTR("TYPE")="SET" D  Q RESULT
  1.  .D BLDSET(ATTR("POINTER"),.SETS)
  1.  .I '$D(SETS($$UP^XLFSTR(VALUE))) S RESULT=0
  1.  ;free text and date
  1.  I ATTR("TYPE")="FREE TEXT"!(ATTR("TYPE")="DATE/TIME") D  Q RESULT
  1.  .S X=VALUE
  1.  .S CODE=ATTR("INPUT TRANSFORM")
  1.  .X CODE
  1.  .I $G(X)="" S RESULT=0
  1.  Q RESULT
  1.  ;