PXRMDGFC ;SLC/AGP - Reminder General Finding Checker;04/13/2021
;;2.0;CLINICAL REMINDERS;**71**;Feb 04, 2005;Build 43
;
;SACC EXEMPTIONS SECTION
;2.3.1.10.1 and 2.3.1.10.2
;
ALL ;
N IEN
S IEN=0 F S IEN=$O(^PXRMD(801.46,IEN)) Q:IEN'>0 D
.D GFENT(IEN)
W !!," Done"
Q
;
BLDSET(SET,OUTPUT) ;
N CNT,PIECE,STR
S PIECE=0
F CNT=1:1:$L(SET) I $E(SET,CNT)=";" S PIECE=PIECE+1 I PIECE>0 D
. S STR=$P($G(SET),";",PIECE)
. S OUTPUT($$UP^XLFSTR($P(STR,":")))=""
. S OUTPUT($$UP^XLFSTR($P(STR,":",2)))=""
Q
;
EN ;
N ARRAY,DARRAY,DCNT,DIEN
S DIEN=$$SELECT()
I DIEN=-1 Q
S DCNT=0
W !,"Checking dialog: "_$P(DIEN,U,2)
D DITEMAR^PXRMDUTL(+DIEN,.ARRAY,.DARRAY,.DCNT)
D PROCESS(.DARRAY)
W !," Done"
Q
;
GETFINDS(FINDINGS,DIEN) ;
N FIND
I $P($G(^PXRMD(801.41,DIEN,1)),U,5)'="" S FINDINGS($P(^PXRMD(801.41,DIEN,1),U,5))=""
S FIND="" F S FIND=$O(^PXRMD(801.41,DIEN,3,"B",FIND)) Q:FIND="" D
.S FINDINGS(FIND)=""
Q
;
GFENT(IEN) ;
N FILENUM,FIELD,NAME,PKG,RESULT,VALUE,X0,X1,X2,X3
S X0=$G(^PXRMD(801.46,IEN,0))
S NAME=$P(X0,U)
S PKG=$P(X0,U,2),FILENUM=$P(X0,U,3)
I +PKG=0 S RESULT=-1 G GFENTX
I FILENUM="" S RESULT=-1 G GFENTX
I FILENUM=100.9 Q
S X1=$G(^PXRMD(801.46,IEN,1))
S X2=$G(^PXRMD(801.46,IEN,2))
S X3=$G(^PXRMD(801.46,IEN,3))
S VALUE=$P(X1,U)
S FIELD=$P(X1,U,2)
I VALUE="" D G GFENTX
.I NAME="WV DIAGNOSIS" S RESULT=1 Q
.I $P(X2,U)'="" S RESULT=1 Q
.I $P(X3,U,3)=1 S RESULT=1 Q
.S RESULT=-1
I +FIELD=0 D G GFENTX
.I $P(X2,U,2)'="" S RESULT=1 Q
.I FIELD'="" S RESULT=1 Q
.S RESULT=-1
;if used for IEN prompt it is valid
I FIELD=.01,VALUE="",$P(X3,U,3)=1 S RESULT=1 G GFENTX
;used as a placeholder to insert the patient DFN
I VALUE="PATIENT" S RESULT=1 G GFENTX
;used to delete values out of file 790
I FILENUM=790&(VALUE="DELETE")&(FIELD=.18!(FIELD=.19)) S RESULT=1 G GFENTX
;used to set patient next due date based off the patient age
I FILENUM=790,VALUE="AGE",FIELD=.19 S RESULT=1 G GFENTX
;used to delete values out of pregnancy/lactation log
I FILENUM=790.9&(FIELD=.01)&(VALUE["P"!(VALUE["L")) S RESULT=1 G GFENTX
;all other validation
S RESULT=$$VALIDATE(IEN,FILENUM,FIELD,VALUE)
GFENTX ;
I RESULT=-1 W !,IEN_": "_NAME_" not setup correctly"
I RESULT=0 W !,IEN_": "_NAME_" failed validation"
Q
;
PROCESS(DARRAY) ;
N DIEN,FIND,FINDINGS
S DIEN=0 F S DIEN=$O(DARRAY(DIEN)) Q:DIEN'>0 D
.K FINDINGS
.D GETFINDS(.FINDINGS,DIEN)
.S FIND="" F S FIND=$O(FINDINGS(FIND)) Q:FIND="" D
..I FIND["PXRMD(801.46" D GFENT(+FIND)
Q
;
SELECT() ;
N DIC,DTOUT,DUOUT,Y
S DIC="^PXRMD(801.41,"
S DIC(0)="AEMQ"
S DIC("A")="Select Reminder Dialog Item: "
S DIC("S")="I $P(^PXRMD(801.41,Y,0),U,4)=""R"""
D ^DIC
I $D(DTOUT)!($D(DUOUT)) S Y=-1
Q Y
;
VALIDATE(IEN,FILENUM,FIELD,VALUE) ;
N ATTR,CODE,MSG,PFILE,RESULT,SETS,TYPE,X
S RESULT=1
S TYPE="FIELD LENGTH;INPUT TRANSFORM;POINTER;SPECIFIER;TYPE"
D FIELD^DID(FILENUM,FIELD,"",TYPE,"ATTR","MSG")
I $D(MSG) W !,"IEN: "_IEN D AWRITE^PXRMUTIL("MSG") Q RESULT
;pointer
I ATTR("TYPE")="POINTER" D Q RESULT
.S PFILE=+$P(ATTR("SPECIFIER"),"P",2)
.;I PFILE=790.404,VALUE'="",+VALUE=0 Q
.I '$$EXISTS^PXRMEXIU(PFILE,VALUE) S RESULT=0
;set of code
I ATTR("TYPE")="SET" D Q RESULT
.D BLDSET(ATTR("POINTER"),.SETS)
.I '$D(SETS($$UP^XLFSTR(VALUE))) S RESULT=0
;free text and date
I ATTR("TYPE")="FREE TEXT"!(ATTR("TYPE")="DATE/TIME") D Q RESULT
.S X=VALUE
.S CODE=ATTR("INPUT TRANSFORM")
.X CODE
.I $G(X)="" S RESULT=0
Q RESULT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDGFC 3572 printed Dec 13, 2024@01:43:44 Page 2
PXRMDGFC ;SLC/AGP - Reminder General Finding Checker;04/13/2021
+1 ;;2.0;CLINICAL REMINDERS;**71**;Feb 04, 2005;Build 43
+2 ;
+3 ;SACC EXEMPTIONS SECTION
+4 ;2.3.1.10.1 and 2.3.1.10.2
+5 ;
ALL ;
+1 NEW IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.46,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 DO GFENT(IEN)
End DoDot:1
+4 WRITE !!," Done"
+5 QUIT
+6 ;
BLDSET(SET,OUTPUT) ;
+1 NEW CNT,PIECE,STR
+2 SET PIECE=0
+3 FOR CNT=1:1:$LENGTH(SET)
IF $EXTRACT(SET,CNT)=";"
SET PIECE=PIECE+1
IF PIECE>0
Begin DoDot:1
+4 SET STR=$PIECE($GET(SET),";",PIECE)
+5 SET OUTPUT($$UP^XLFSTR($PIECE(STR,":")))=""
+6 SET OUTPUT($$UP^XLFSTR($PIECE(STR,":",2)))=""
End DoDot:1
+7 QUIT
+8 ;
EN ;
+1 NEW ARRAY,DARRAY,DCNT,DIEN
+2 SET DIEN=$$SELECT()
+3 IF DIEN=-1
QUIT
+4 SET DCNT=0
+5 WRITE !,"Checking dialog: "_$PIECE(DIEN,U,2)
+6 DO DITEMAR^PXRMDUTL(+DIEN,.ARRAY,.DARRAY,.DCNT)
+7 DO PROCESS(.DARRAY)
+8 WRITE !," Done"
+9 QUIT
+10 ;
GETFINDS(FINDINGS,DIEN) ;
+1 NEW FIND
+2 IF $PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)'=""
SET FINDINGS($PIECE(^PXRMD(801.41,DIEN,1),U,5))=""
+3 SET FIND=""
FOR
SET FIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",FIND))
if FIND=""
QUIT
Begin DoDot:1
+4 SET FINDINGS(FIND)=""
End DoDot:1
+5 QUIT
+6 ;
GFENT(IEN) ;
+1 NEW FILENUM,FIELD,NAME,PKG,RESULT,VALUE,X0,X1,X2,X3
+2 SET X0=$GET(^PXRMD(801.46,IEN,0))
+3 SET NAME=$PIECE(X0,U)
+4 SET PKG=$PIECE(X0,U,2)
SET FILENUM=$PIECE(X0,U,3)
+5 IF +PKG=0
SET RESULT=-1
GOTO GFENTX
+6 IF FILENUM=""
SET RESULT=-1
GOTO GFENTX
+7 IF FILENUM=100.9
QUIT
+8 SET X1=$GET(^PXRMD(801.46,IEN,1))
+9 SET X2=$GET(^PXRMD(801.46,IEN,2))
+10 SET X3=$GET(^PXRMD(801.46,IEN,3))
+11 SET VALUE=$PIECE(X1,U)
+12 SET FIELD=$PIECE(X1,U,2)
+13 IF VALUE=""
Begin DoDot:1
+14 IF NAME="WV DIAGNOSIS"
SET RESULT=1
QUIT
+15 IF $PIECE(X2,U)'=""
SET RESULT=1
QUIT
+16 IF $PIECE(X3,U,3)=1
SET RESULT=1
QUIT
+17 SET RESULT=-1
End DoDot:1
GOTO GFENTX
+18 IF +FIELD=0
Begin DoDot:1
+19 IF $PIECE(X2,U,2)'=""
SET RESULT=1
QUIT
+20 IF FIELD'=""
SET RESULT=1
QUIT
+21 SET RESULT=-1
End DoDot:1
GOTO GFENTX
+22 ;if used for IEN prompt it is valid
+23 IF FIELD=.01
IF VALUE=""
IF $PIECE(X3,U,3)=1
SET RESULT=1
GOTO GFENTX
+24 ;used as a placeholder to insert the patient DFN
+25 IF VALUE="PATIENT"
SET RESULT=1
GOTO GFENTX
+26 ;used to delete values out of file 790
+27 IF FILENUM=790&(VALUE="DELETE")&(FIELD=.18!(FIELD=.19))
SET RESULT=1
GOTO GFENTX
+28 ;used to set patient next due date based off the patient age
+29 IF FILENUM=790
IF VALUE="AGE"
IF FIELD=.19
SET RESULT=1
GOTO GFENTX
+30 ;used to delete values out of pregnancy/lactation log
+31 IF FILENUM=790.9&(FIELD=.01)&(VALUE["P"!(VALUE["L"))
SET RESULT=1
GOTO GFENTX
+32 ;all other validation
+33 SET RESULT=$$VALIDATE(IEN,FILENUM,FIELD,VALUE)
GFENTX ;
+1 IF RESULT=-1
WRITE !,IEN_": "_NAME_" not setup correctly"
+2 IF RESULT=0
WRITE !,IEN_": "_NAME_" failed validation"
+3 QUIT
+4 ;
PROCESS(DARRAY) ;
+1 NEW DIEN,FIND,FINDINGS
+2 SET DIEN=0
FOR
SET DIEN=$ORDER(DARRAY(DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+3 KILL FINDINGS
+4 DO GETFINDS(.FINDINGS,DIEN)
+5 SET FIND=""
FOR
SET FIND=$ORDER(FINDINGS(FIND))
if FIND=""
QUIT
Begin DoDot:2
+6 IF FIND["PXRMD(801.46"
DO GFENT(+FIND)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
SELECT() ;
+1 NEW DIC,DTOUT,DUOUT,Y
+2 SET DIC="^PXRMD(801.41,"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Reminder Dialog Item: "
+5 SET DIC("S")="I $P(^PXRMD(801.41,Y,0),U,4)=""R"""
+6 DO ^DIC
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
SET Y=-1
+8 QUIT Y
+9 ;
VALIDATE(IEN,FILENUM,FIELD,VALUE) ;
+1 NEW ATTR,CODE,MSG,PFILE,RESULT,SETS,TYPE,X
+2 SET RESULT=1
+3 SET TYPE="FIELD LENGTH;INPUT TRANSFORM;POINTER;SPECIFIER;TYPE"
+4 DO FIELD^DID(FILENUM,FIELD,"",TYPE,"ATTR","MSG")
+5 IF $DATA(MSG)
WRITE !,"IEN: "_IEN
DO AWRITE^PXRMUTIL("MSG")
QUIT RESULT
+6 ;pointer
+7 IF ATTR("TYPE")="POINTER"
Begin DoDot:1
+8 SET PFILE=+$PIECE(ATTR("SPECIFIER"),"P",2)
+9 ;I PFILE=790.404,VALUE'="",+VALUE=0 Q
+10 IF '$$EXISTS^PXRMEXIU(PFILE,VALUE)
SET RESULT=0
End DoDot:1
QUIT RESULT
+11 ;set of code
+12 IF ATTR("TYPE")="SET"
Begin DoDot:1
+13 DO BLDSET(ATTR("POINTER"),.SETS)
+14 IF '$DATA(SETS($$UP^XLFSTR(VALUE)))
SET RESULT=0
End DoDot:1
QUIT RESULT
+15 ;free text and date
+16 IF ATTR("TYPE")="FREE TEXT"!(ATTR("TYPE")="DATE/TIME")
Begin DoDot:1
+17 SET X=VALUE
+18 SET CODE=ATTR("INPUT TRANSFORM")
+19 XECUTE CODE
+20 IF $GET(X)=""
SET RESULT=0
End DoDot:1
QUIT RESULT
+21 QUIT RESULT
+22 ;
