PXRMDLLC ;SLC/AGP - REMINDER DIALOG LOADER ;08/17/2018
;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
;
BLDPTYPE(DIEN,PROMPTS) ;
N DSUB,DCIEN,PTIEN
S DSUB=0 F S DSUB=$O(^PXRMD(801.41,DIEN,10,DSUB)) Q:DSUB'>0 D
.S DCIEN=$P($G(^PXRMD(801.41,DIEN,10,DSUB,0)),U,2) Q:'DCIEN
.I $$ISDISAB^PXRMDLL(DCIEN)=1 Q
.I "PF"'[$P($G(^PXRMD(801.41,DCIEN,0)),U,4) Q
.S PTIEN=$P($G(^PXRMD(801.41,DCIEN,46)),U) I PTIEN'>0 Q
.S PROMPTS(PTIEN)=""
Q
;
BLDVISIT(VISITID) ;
K ^TMP($J,"PXRM DIALOG VISIT INFO")
N LOC,SER,DATETIME
I VISITID[";" D
.S LOC=+$P(VISITID,";"),DATETIME=$P(VISITID,";",2),SER=$P(VISITID,";",3)
I VISITID'[";" D
.S LOC=+$P($G(^AUPNVSIT(VISITID,0)),U,22)
.S DATETIME=$P($G(^AUPNVSIT(VISITID,0)),U)
.S SER=$P($G(^AUPNVSIT(VISITID,0)),U,7)
S ^TMP($J,"PXRM DIALOG VISIT INFO","DATETIME")=DATETIME
S ^TMP($J,"PXRM DIALOG VISIT INFO","LOCATION")=LOC_U_$S(LOC>0:$P($G(^SC(LOC,0)),U),1:"")
S ^TMP($J,"PXRM DIALOG VISIT INFO","SERVICE CATEGORY")=SER
Q
;
DCHK(DIEN) ;
; this function will check each element/group showing a checkbox.
;if the item has a General Reminder Finding it will check to see if the finding exists in the TMP global.
;if it does it will return a value of "C" can probably be change to a 1/0 return value
I +$G(CHKLVL)'=1 Q ""
I '$D(^TMP($J,"PXRM GEN FINDING",DIALOGIEN)) Q ""
N DOCHCK,FIELD,FILE,FIND,FINDS,FOUND,IENS,NODE,NUM,PFIELD,PKG,PROMPTS,VALUE
;^TMP($J,"PXRM GEN FINDING",DIEN,PKGNAME,FILE NUMBER,FIELD NUMBER,IENS)
;IENS can be a multiple
;build array of general finding types
S FIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
I FIND["801.46",$$ISVALID(+FIND,DIEN) M FINDS(+FIND)=^PXRMD(801.46,+FIND)
;check additional findings
S NUM=0 F S NUM=$O(^PXRMD(801.41,DIEN,3,NUM)) Q:NUM'>0 D
.S FIND=$P($G(^PXRMD(801.41,DIEN,3,NUM,0)),U) I FIND["801.46",$$ISVALID(+FIND,DIEN) M FINDS(+FIND)=^PXRMD(801.46,+FIND)
I '$D(FINDS) Q ""
;build array of prompts type for the DIEN
D BLDPTYPE(DIEN,.PROMPTS)
;check for general finding types in the TMP global
S NUM=0,FOUND=0 F S NUM=$O(FINDS(NUM)) Q:NUM'>0!(FOUND=1) D
.;S NODE=$G(FINDS(NUM,0)),PKG=$$GET1^DIQ(9.4,$P(NODE,U,2),.01),FILE=$P(NODE,U,3),FIELD=$P($G(FINDS(NUM,1)),U,2)
.S NODE=$G(FINDS(NUM,0)),PKG=$P(NODE,U,2),FILE=$P(NODE,U,3),FIELD=$P($G(FINDS(NUM,1)),U,2),PFIELD=$P($G(FINDS(NUM,2)),U,2)
.S DOCHCK=0
.I FIELD'="",$D(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD)) S DOCHCK=1
.I PFIELD'="",$D(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,PFIELD)) S DOCHCK=1
.I DOCHCK=0 Q
.;if prompt value is defined check for existing prompt type in dialog item.
.I $P($G(FINDS(NUM,2)),U)'="",$D(PROMPTS($P($G(FINDS(NUM,2)),U))) S FOUND=1 Q
.;quit if value is not defined
.I $P($G(FINDS(NUM,1)),U)="" Q
.;check to see if return value matches value returned from branching logic
.S IENS="" F S IENS=$O(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) Q:IENS="" D
..I $P($G(FINDS(NUM,1)),U)=$G(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) S FOUND=1
;AGP COMMENTED OUT HANDLE CODE TO CHECK FOR PROMPTS
;.I $P($G(FINDS(NUM,1)),U)'="",$D(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD)) D
;..S IENS="" F S IENS=$O(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) Q:IENS="" D
;...I $P($G(FINDS(NUM,1)),U)=$G(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) S FOUND=1
I FOUND=1 Q "C"
Q ""
;
ISVALID(FIND,DIEN) ;
I $P($G(^PXRMD(801.41,DIEN,"DATA")),U,2)=1 Q 0
;AGP change to check for prompt type also.
I $P($G(^PXRMD(801.46,FIND,1)),U)="",$P($G(^PXRMD(801.46,FIND,2)),U)="" Q 0
Q 1
;
FIND(FIND) ;
Q
;
CHKHLVL(ORY,OCNT,CHKSTAT) ;
; this function starts at OCNT and works it way back up the ORY array
;the purpose of this function is to set high level element/groups to check for the item set to checked in $$DCHK
;condition the possible element must be in the direction sequence of the checked item. It must also be set to show a check box
;;examples
;; 5 <== Should be set to check from the LSTHCK procedure
;; 5.10 <== Should be set to check from this function
;; 5.10.5 <== Should be set to check from this function
;; 5.10.5.10
;; 5.10.5.15.5
;; 5.10.5.15.10 <== Should be set to check from this function
;; 5.10.5.15.10.5
;; 5.10.5.15.10.15 <== is starting checked from $$DCHK
;; 10
N DONE,FOUND,ESEQ,FOUND,TCNT,SEQ,TSEQ,TSEQ1,PIECE,DIEN
I +$G(CHKLVL)'=1 Q
S SEQ=$P(ORY(OCNT),U,3)
S PIECE=$L(SEQ,".") I PIECE=1 Q
;get first parent sequence
S TCNT=OCNT,TSEQ=$P(SEQ,".",1,PIECE-1)
S PIECE=PIECE-1
;while look this loop will continue until at fist level sequence then it does a check at that sequence level
S DONE=0
F D I DONE=1!($L(TSEQ,".")=1) Q
.S FOUND=0 F S TCNT=$O(ORY(TCNT),-1) Q:TCNT<1!(FOUND=1)!(DONE=1) D
..S NODE=$G(ORY(TCNT)) I $P(NODE,U)>1 Q
..S TSEQ1=$P(NODE,U,3),DIEN=$P(NODE,U,2)
..I TSEQ'=TSEQ1 Q
..I $P($G(CHKSTAT(TSEQ)),U)=DIEN,$P($G(CHKSTAT(TSEQ)),U,2)=0 S DONE=1 Q
..I $P(NODE,U,4)="C" S DONE=1 Q
..;must be set to show a checkbox, and the item cannot have findings
..I $P(NODE,U,4)="S",'$$HASFIND($P(NODE,U,2)) S $P(ORY(TCNT),U,4)="C"
..I $P(ORY(TCNT),U,4)="S" S DONE=1 Q
..;remove last sequence number to restart or end the while loop
..I PIECE>0 S PIECE=PIECE-1
..S TSEQ=$P(TSEQ,".",1,PIECE),FOUND=1
I DONE=0 D LSTHCHK(.ORY,TSEQ,TCNT+1,.CHKSTAT)
Q
;
LSTHCHK(ORY,TSEQ,TCNT,CHKSTAT) ;
;;this function does the same as above but only checks the last single check level
;;example sequence of 5,10,15,20
N DONE,NODE,DIEN
S DONE=0 F S TCNT=$O(ORY(TCNT),-1) Q:TCNT<1!(DONE=1) D
.S NODE=$G(ORY(TCNT)),DIEN=$P(NODE,U,2) I $P(NODE,U)>1 Q
.I $P(NODE,U,3)=TSEQ D
..I $P(NODE,U,4)="C" S DONE=1 Q
..I $P($G(CHKSTAT(TSEQ)),U)=DIEN,$P($G(CHKSTAT(TSEQ)),U,2)=0 S DONE=1 Q
..;I $P(NODE,U,4)="S" S $P(ORY(TCNT),U,4)="C"
..I $P(NODE,U,4)="S",'$$HASFIND($P(NODE,U,2)) S $P(ORY(TCNT),U,4)="C"
..S DONE=1
.I $P(NODE,U,3)<TSEQ S DONE=1 Q
Q
;
HASFIND(DIEN) ;
I $P($G(^PXRMD(801.41,DIEN,1)),U,5)'="" Q 1
I $D(^PXRMD(801.41,DIEN,3))>10 Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLLC 6225 printed Dec 13, 2024@01:44:05 Page 2
PXRMDLLC ;SLC/AGP - REMINDER DIALOG LOADER ;08/17/2018
+1 ;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
+2 ;
BLDPTYPE(DIEN,PROMPTS) ;
+1 NEW DSUB,DCIEN,PTIEN
+2 SET DSUB=0
FOR
SET DSUB=$ORDER(^PXRMD(801.41,DIEN,10,DSUB))
if DSUB'>0
QUIT
Begin DoDot:1
+3 SET DCIEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,DSUB,0)),U,2)
if 'DCIEN
QUIT
+4 IF $$ISDISAB^PXRMDLL(DCIEN)=1
QUIT
+5 IF "PF"'[$PIECE($GET(^PXRMD(801.41,DCIEN,0)),U,4)
QUIT
+6 SET PTIEN=$PIECE($GET(^PXRMD(801.41,DCIEN,46)),U)
IF PTIEN'>0
QUIT
+7 SET PROMPTS(PTIEN)=""
End DoDot:1
+8 QUIT
+9 ;
BLDVISIT(VISITID) ;
+1 KILL ^TMP($JOB,"PXRM DIALOG VISIT INFO")
+2 NEW LOC,SER,DATETIME
+3 IF VISITID[";"
Begin DoDot:1
+4 SET LOC=+$PIECE(VISITID,";")
SET DATETIME=$PIECE(VISITID,";",2)
SET SER=$PIECE(VISITID,";",3)
End DoDot:1
+5 IF VISITID'[";"
Begin DoDot:1
+6 SET LOC=+$PIECE($GET(^AUPNVSIT(VISITID,0)),U,22)
+7 SET DATETIME=$PIECE($GET(^AUPNVSIT(VISITID,0)),U)
+8 SET SER=$PIECE($GET(^AUPNVSIT(VISITID,0)),U,7)
End DoDot:1
+9 SET ^TMP($JOB,"PXRM DIALOG VISIT INFO","DATETIME")=DATETIME
+10 SET ^TMP($JOB,"PXRM DIALOG VISIT INFO","LOCATION")=LOC_U_$SELECT(LOC>0:$PIECE($GET(^SC(LOC,0)),U),1:"")
+11 SET ^TMP($JOB,"PXRM DIALOG VISIT INFO","SERVICE CATEGORY")=SER
+12 QUIT
+13 ;
DCHK(DIEN) ;
+1 ; this function will check each element/group showing a checkbox.
+2 ;if the item has a General Reminder Finding it will check to see if the finding exists in the TMP global.
+3 ;if it does it will return a value of "C" can probably be change to a 1/0 return value
+4 IF +$GET(CHKLVL)'=1
QUIT ""
+5 IF '$DATA(^TMP($JOB,"PXRM GEN FINDING",DIALOGIEN))
QUIT ""
+6 NEW DOCHCK,FIELD,FILE,FIND,FINDS,FOUND,IENS,NODE,NUM,PFIELD,PKG,PROMPTS,VALUE
+7 ;^TMP($J,"PXRM GEN FINDING",DIEN,PKGNAME,FILE NUMBER,FIELD NUMBER,IENS)
+8 ;IENS can be a multiple
+9 ;build array of general finding types
+10 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+11 IF FIND["801.46"
IF $$ISVALID(+FIND,DIEN)
MERGE FINDS(+FIND)=^PXRMD(801.46,+FIND)
+12 ;check additional findings
+13 SET NUM=0
FOR
SET NUM=$ORDER(^PXRMD(801.41,DIEN,3,NUM))
if NUM'>0
QUIT
Begin DoDot:1
+14 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,3,NUM,0)),U)
IF FIND["801.46"
IF $$ISVALID(+FIND,DIEN)
MERGE FINDS(+FIND)=^PXRMD(801.46,+FIND)
End DoDot:1
+15 IF '$DATA(FINDS)
QUIT ""
+16 ;build array of prompts type for the DIEN
+17 DO BLDPTYPE(DIEN,.PROMPTS)
+18 ;check for general finding types in the TMP global
+19 SET NUM=0
SET FOUND=0
FOR
SET NUM=$ORDER(FINDS(NUM))
if NUM'>0!(FOUND=1)
QUIT
Begin DoDot:1
+20 ;S NODE=$G(FINDS(NUM,0)),PKG=$$GET1^DIQ(9.4,$P(NODE,U,2),.01),FILE=$P(NODE,U,3),FIELD=$P($G(FINDS(NUM,1)),U,2)
+21 SET NODE=$GET(FINDS(NUM,0))
SET PKG=$PIECE(NODE,U,2)
SET FILE=$PIECE(NODE,U,3)
SET FIELD=$PIECE($GET(FINDS(NUM,1)),U,2)
SET PFIELD=$PIECE($GET(FINDS(NUM,2)),U,2)
+22 SET DOCHCK=0
+23 IF FIELD'=""
IF $DATA(^TMP($JOB,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD))
SET DOCHCK=1
+24 IF PFIELD'=""
IF $DATA(^TMP($JOB,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,PFIELD))
SET DOCHCK=1
+25 IF DOCHCK=0
QUIT
+26 ;if prompt value is defined check for existing prompt type in dialog item.
+27 IF $PIECE($GET(FINDS(NUM,2)),U)'=""
IF $DATA(PROMPTS($PIECE($GET(FINDS(NUM,2)),U)))
SET FOUND=1
QUIT
+28 ;quit if value is not defined
+29 IF $PIECE($GET(FINDS(NUM,1)),U)=""
QUIT
+30 ;check to see if return value matches value returned from branching logic
+31 SET IENS=""
FOR
SET IENS=$ORDER(^TMP($JOB,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS))
if IENS=""
QUIT
Begin DoDot:2
+32 IF $PIECE($GET(FINDS(NUM,1)),U)=$GET(^TMP($JOB,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS))
SET FOUND=1
End DoDot:2
End DoDot:1
+33 ;AGP COMMENTED OUT HANDLE CODE TO CHECK FOR PROMPTS
+34 ;.I $P($G(FINDS(NUM,1)),U)'="",$D(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD)) D
+35 ;..S IENS="" F S IENS=$O(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) Q:IENS="" D
+36 ;...I $P($G(FINDS(NUM,1)),U)=$G(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IENS)) S FOUND=1
+37 IF FOUND=1
QUIT "C"
+38 QUIT ""
+39 ;
ISVALID(FIND,DIEN) ;
+1 IF $PIECE($GET(^PXRMD(801.41,DIEN,"DATA")),U,2)=1
QUIT 0
+2 ;AGP change to check for prompt type also.
+3 IF $PIECE($GET(^PXRMD(801.46,FIND,1)),U)=""
IF $PIECE($GET(^PXRMD(801.46,FIND,2)),U)=""
QUIT 0
+4 QUIT 1
+5 ;
FIND(FIND) ;
+1 QUIT
+2 ;
CHKHLVL(ORY,OCNT,CHKSTAT) ;
+1 ; this function starts at OCNT and works it way back up the ORY array
+2 ;the purpose of this function is to set high level element/groups to check for the item set to checked in $$DCHK
+3 ;condition the possible element must be in the direction sequence of the checked item. It must also be set to show a check box
+4 ;;examples
+5 ;; 5 <== Should be set to check from the LSTHCK procedure
+6 ;; 5.10 <== Should be set to check from this function
+7 ;; 5.10.5 <== Should be set to check from this function
+8 ;; 5.10.5.10
+9 ;; 5.10.5.15.5
+10 ;; 5.10.5.15.10 <== Should be set to check from this function
+11 ;; 5.10.5.15.10.5
+12 ;; 5.10.5.15.10.15 <== is starting checked from $$DCHK
+13 ;; 10
+14 NEW DONE,FOUND,ESEQ,FOUND,TCNT,SEQ,TSEQ,TSEQ1,PIECE,DIEN
+15 IF +$GET(CHKLVL)'=1
QUIT
+16 SET SEQ=$PIECE(ORY(OCNT),U,3)
+17 SET PIECE=$LENGTH(SEQ,".")
IF PIECE=1
QUIT
+18 ;get first parent sequence
+19 SET TCNT=OCNT
SET TSEQ=$PIECE(SEQ,".",1,PIECE-1)
+20 SET PIECE=PIECE-1
+21 ;while look this loop will continue until at fist level sequence then it does a check at that sequence level
+22 SET DONE=0
+23 FOR
Begin DoDot:1
+24 SET FOUND=0
FOR
SET TCNT=$ORDER(ORY(TCNT),-1)
if TCNT<1!(FOUND=1)!(DONE=1)
QUIT
Begin DoDot:2
+25 SET NODE=$GET(ORY(TCNT))
IF $PIECE(NODE,U)>1
QUIT
+26 SET TSEQ1=$PIECE(NODE,U,3)
SET DIEN=$PIECE(NODE,U,2)
+27 IF TSEQ'=TSEQ1
QUIT
+28 IF $PIECE($GET(CHKSTAT(TSEQ)),U)=DIEN
IF $PIECE($GET(CHKSTAT(TSEQ)),U,2)=0
SET DONE=1
QUIT
+29 IF $PIECE(NODE,U,4)="C"
SET DONE=1
QUIT
+30 ;must be set to show a checkbox, and the item cannot have findings
+31 IF $PIECE(NODE,U,4)="S"
IF '$$HASFIND($PIECE(NODE,U,2))
SET $PIECE(ORY(TCNT),U,4)="C"
+32 IF $PIECE(ORY(TCNT),U,4)="S"
SET DONE=1
QUIT
+33 ;remove last sequence number to restart or end the while loop
+34 IF PIECE>0
SET PIECE=PIECE-1
+35 SET TSEQ=$PIECE(TSEQ,".",1,PIECE)
SET FOUND=1
End DoDot:2
End DoDot:1
IF DONE=1!($LENGTH(TSEQ,".")=1)
QUIT
+36 IF DONE=0
DO LSTHCHK(.ORY,TSEQ,TCNT+1,.CHKSTAT)
+37 QUIT
+38 ;
LSTHCHK(ORY,TSEQ,TCNT,CHKSTAT) ;
+1 ;;this function does the same as above but only checks the last single check level
+2 ;;example sequence of 5,10,15,20
+3 NEW DONE,NODE,DIEN
+4 SET DONE=0
FOR
SET TCNT=$ORDER(ORY(TCNT),-1)
if TCNT<1!(DONE=1)
QUIT
Begin DoDot:1
+5 SET NODE=$GET(ORY(TCNT))
SET DIEN=$PIECE(NODE,U,2)
IF $PIECE(NODE,U)>1
QUIT
+6 IF $PIECE(NODE,U,3)=TSEQ
Begin DoDot:2
+7 IF $PIECE(NODE,U,4)="C"
SET DONE=1
QUIT
+8 IF $PIECE($GET(CHKSTAT(TSEQ)),U)=DIEN
IF $PIECE($GET(CHKSTAT(TSEQ)),U,2)=0
SET DONE=1
QUIT
+9 ;I $P(NODE,U,4)="S" S $P(ORY(TCNT),U,4)="C"
+10 IF $PIECE(NODE,U,4)="S"
IF '$$HASFIND($PIECE(NODE,U,2))
SET $PIECE(ORY(TCNT),U,4)="C"
+11 SET DONE=1
End DoDot:2
+12 IF $PIECE(NODE,U,3)<TSEQ
SET DONE=1
QUIT
End DoDot:1
+13 QUIT
+14 ;
HASFIND(DIEN) ;
+1 IF $PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)'=""
QUIT 1
+2 IF $DATA(^PXRMD(801.41,DIEN,3))>10
QUIT 1
+3 QUIT 0
+4 ;
