- PSGOEF2 ;BIR/JMC - INPATIENT MEDS OVERLAPPING ADMIN TIMES ;23 Jun 09 / 2:48 PM
- ;;5.0; INPATIENT MEDICATIONS ;**222**;16 DEC 97;Build 5
- ;
- ; Reference to ORCD is supported by DBIA 5493.
- ;
- Q
- ;
- OVERLAP ; Check for overlapping admin times on complex orders with "AND" conjunction.
- K ORDIALOG,^TMP("PSJATOVR",$J) ;Have to use array name ORDIALOG even though it's not PSJ namespaced.
- S PSJOVRLP=0
- N PSJORDLG,X,CNT,TOTCONJ
- S PSJORDLG=$$PTR^ORCD("PSJ OR PAT OE") I PSJORDLG="" Q ;locates dialog sequence for Inpatient Meds dialog in CPRS.
- D GETDLG^ORCD(PSJORDLG) ;retrieves info about Inpatient Meds dialog setup in CPRS
- S X="" F S X=$O(ORDIALOG(X)) Q:X="" D
- . I $P($G(ORDIALOG(X)),"^",2)="CONJ" D GETDLG1^ORCD(PSJORDLG),GETORDER^ORCD(PSJCOM) M PSJOVR("CONJ")=ORDIALOG(X)
- . I $P($G(ORDIALOG(X)),"^",2)="ADMIN" D GETDLG1^ORCD(PSJORDLG),GETORDER^ORCD(PSJCOM) M PSJOVR("ADMIN")=ORDIALOG(X)
- . I $P($G(ORDIALOG(X)),"^",2)="SCHEDULE" D GETDLG1^ORCD(PSJORDLG),GETORDER^ORCD(PSJCOM) M PSJOVR("SCHEDULE")=ORDIALOG(X)
- K ORDIALOG
- ; Clean up array below by killing unnecessary nodes
- F X="CONJ","ADMIN","SCHEDULE" K PSJOVR(X,0),PSJOVR(X,"A"),PSJOVR(X,"?"),PSJOVR(X,"??") I X="ADMIN" M PSJOVR(X_"O")=PSJOVR(X)
- ; Look for no AND conjunctions. If no AND conjuncitons, quit.
- S X="",CNT=0,TOTCONJ=$O(PSJOVR("CONJ",""),-1)
- F S X=$O(PSJOVR("CONJ",X)) Q:X="" I PSJOVR("CONJ",X)="A" S CNT=CNT+1
- Q:CNT=0 ;if CNT=0, there are no AND conjunctions in the order. No need to proceed further.
- D BUILD
- ; Format all admin times to 4 digit length for comparison.
- S X="" F S X=$O(PSJOVR("ADMIN",X)) Q:X="" D
- . S X1=$G(PSJOVR("ADMIN",X)),X2=$L(X1,"-")
- . F X3=1:1:X2 D
- . . I $L($P(X1,"-",X3))<4 S $P(X1,"-",X3)=$P(X1,"-",X3)_"00"
- . . S PSJOVR("ADMIN",X)=X1,PSJADOV(X,$P(X1,"-",X3))=""
- ; Order contains all AND conjunctions, no THEN conjunctions.
- I CNT=TOTCONJ D CHK,EXIT Q
- ; Piece order back together in a string of part number, conjunction
- ; Produces a string like 1A2T3 - part 1 AND part 2 THEN part 3
- S X="" F S X=$O(PSJOVR("ADMIN",X)) Q:X="" D
- . S PSJOVR("STRING")=$G(PSJOVR("STRING"))_X_$G(PSJOVR("CONJ",X))
- . S PSJTHEN=$L(PSJOVR("STRING"),"T")
- . S PSJTHEN1="" F PSJTHEN1=1:1:PSJTHEN D
- . . I $P(PSJOVR("STRING"),"T",PSJTHEN1)'["A" Q ;No need to check for overlap if only one part to a THEN conjunction
- . . S PSJAND=$L($P(PSJOVR("STRING"),"T",PSJTHEN1),"A")
- . . S PSJAND1="" F PSJAND1=1:1:PSJAND D
- . . . S PSJAND(PSJTHEN1,PSJAND1)=$P($P(PSJOVR("STRING"),"T",PSJTHEN1),"A",PSJAND1)
- D CHK2,EXIT
- Q
- CHK ;
- Q:'CNT
- K PSJADOVR
- S X=""
- F X=1:1:CNT D
- . S X2="" F S X2=$O(PSJADOV(X2)) Q:X2="" D
- . . S X3="" F S X3=$O(PSJADOV(X2,X3)) Q:X3="" D
- . . . I $D(PSJADOV(X2+X,X3)) S $P(^TMP("PSJATOVR",$J,X2),"^",4)=1,$P(^TMP("PSJATOVR",$J,X2+X),"^",4)=1,PSJOVRLP=1
- Q
- ;
- CHK2 ;
- Q:'$G(PSJAND1)
- S (X,X1,X2,X3,X4,PSJZT)=""
- K PSJADOVR
- F X=1:1:PSJAND1 D
- . S X2="" F S X2=$O(PSJAND(X2)) Q:X2="" D
- . . S X3="" F S X3=$O(PSJAND(X2,X3)) Q:X3="" D
- . . . S X4=$G(PSJAND(X2,X3))
- . . . Q:X4=""
- . . . M PSJADOVR(X2,X3,X4)=PSJADOV(X4)
- F PSJZT=1:1:PSJAND1 D
- . S X="" F S X=$O(PSJADOVR(X)) Q:X="" D
- . . S X1="" F S X1=$O(PSJADOVR(X,X1)) Q:X1="" D
- . . . S X2="" F S X2=$O(PSJADOVR(X,X1,X2)) Q:X2="" D
- . . . . S X3="" F S X3=$O(PSJADOVR(X,X1,X2,X3)) Q:X3="" D
- . . . . . I $D(PSJADOVR(X,X1+PSJZT,X2+PSJZT,X3)) S $P(^TMP("PSJATOVR",$J,X2),"^",4)=1,$P(^TMP("PSJATOVR",$J,X2+PSJZT),"^",4)=1,PSJOVRLP=1
- Q
- ;
- BUILD ;
- S X="" F S X=$O(PSJOVR("SCHEDULE",X)) Q:X="" S ^TMP("PSJATOVR",$J,X)=X_"^"_$G(PSJOVR("SCHEDULE",X))
- S X="" F S X=$O(PSJOVR("ADMIN",X)) Q:X="" S ^TMP("PSJATOVR",$J,X)=^TMP("PSJATOVR",$J,X)_"^"_$G(PSJOVR("ADMIN",X))_"^0"
- Q
- ;
- EXIT ; Kill variables
- K PSJAND,PSJAND1,PSJTHEN,PSJTHEN1,PSJADOVR,PSJADOV,PSJADOV2
- K X,X1,X2,X3,X4,PSJZT,TOTCONJ,CNT,PSJORDLG
- Q
- PSGOEF2 ;BIR/JMC - INPATIENT MEDS OVERLAPPING ADMIN TIMES ;23 Jun 09 / 2:48 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**222**;16 DEC 97;Build 5
- +2 ;
- +3 ; Reference to ORCD is supported by DBIA 5493.
- +4 ;
- +5 QUIT
- +6 ;
- OVERLAP ; Check for overlapping admin times on complex orders with "AND" conjunction.
- +1 ;Have to use array name ORDIALOG even though it's not PSJ namespaced.
- KILL ORDIALOG,^TMP("PSJATOVR",$JOB)
- +2 SET PSJOVRLP=0
- +3 NEW PSJORDLG,X,CNT,TOTCONJ
- +4 ;locates dialog sequence for Inpatient Meds dialog in CPRS.
- SET PSJORDLG=$$PTR^ORCD("PSJ OR PAT OE")
- IF PSJORDLG=""
- QUIT
- +5 ;retrieves info about Inpatient Meds dialog setup in CPRS
- DO GETDLG^ORCD(PSJORDLG)
- +6 SET X=""
- FOR
- SET X=$ORDER(ORDIALOG(X))
- IF X=""
- QUIT
- Begin DoDot:1
- +7 IF $PIECE($GET(ORDIALOG(X)),"^",2)="CONJ"
- DO GETDLG1^ORCD(PSJORDLG)
- DO GETORDER^ORCD(PSJCOM)
- MERGE PSJOVR("CONJ")=ORDIALOG(X)
- +8 IF $PIECE($GET(ORDIALOG(X)),"^",2)="ADMIN"
- DO GETDLG1^ORCD(PSJORDLG)
- DO GETORDER^ORCD(PSJCOM)
- MERGE PSJOVR("ADMIN")=ORDIALOG(X)
- +9 IF $PIECE($GET(ORDIALOG(X)),"^",2)="SCHEDULE"
- DO GETDLG1^ORCD(PSJORDLG)
- DO GETORDER^ORCD(PSJCOM)
- MERGE PSJOVR("SCHEDULE")=ORDIALOG(X)
- End DoDot:1
- +10 KILL ORDIALOG
- +11 ; Clean up array below by killing unnecessary nodes
- +12 FOR X="CONJ","ADMIN","SCHEDULE"
- KILL PSJOVR(X,0),PSJOVR(X,"A"),PSJOVR(X,"?"),PSJOVR(X,"??")
- IF X="ADMIN"
- MERGE PSJOVR(X_"O")=PSJOVR(X)
- +13 ; Look for no AND conjunctions. If no AND conjuncitons, quit.
- +14 SET X=""
- SET CNT=0
- SET TOTCONJ=$ORDER(PSJOVR("CONJ",""),-1)
- +15 FOR
- SET X=$ORDER(PSJOVR("CONJ",X))
- IF X=""
- QUIT
- IF PSJOVR("CONJ",X)="A"
- SET CNT=CNT+1
- +16 ;if CNT=0, there are no AND conjunctions in the order. No need to proceed further.
- IF CNT=0
- QUIT
- +17 DO BUILD
- +18 ; Format all admin times to 4 digit length for comparison.
- +19 SET X=""
- FOR
- SET X=$ORDER(PSJOVR("ADMIN",X))
- IF X=""
- QUIT
- Begin DoDot:1
- +20 SET X1=$GET(PSJOVR("ADMIN",X))
- SET X2=$LENGTH(X1,"-")
- +21 FOR X3=1:1:X2
- Begin DoDot:2
- +22 IF $LENGTH($PIECE(X1,"-",X3))<4
- SET $PIECE(X1,"-",X3)=$PIECE(X1,"-",X3)_"00"
- +23 SET PSJOVR("ADMIN",X)=X1
- SET PSJADOV(X,$PIECE(X1,"-",X3))=""
- End DoDot:2
- End DoDot:1
- +24 ; Order contains all AND conjunctions, no THEN conjunctions.
- +25 IF CNT=TOTCONJ
- DO CHK
- DO EXIT
- QUIT
- +26 ; Piece order back together in a string of part number, conjunction
- +27 ; Produces a string like 1A2T3 - part 1 AND part 2 THEN part 3
- +28 SET X=""
- FOR
- SET X=$ORDER(PSJOVR("ADMIN",X))
- IF X=""
- QUIT
- Begin DoDot:1
- +29 SET PSJOVR("STRING")=$GET(PSJOVR("STRING"))_X_$GET(PSJOVR("CONJ",X))
- +30 SET PSJTHEN=$LENGTH(PSJOVR("STRING"),"T")
- +31 SET PSJTHEN1=""
- FOR PSJTHEN1=1:1:PSJTHEN
- Begin DoDot:2
- +32 ;No need to check for overlap if only one part to a THEN conjunction
- IF $PIECE(PSJOVR("STRING"),"T",PSJTHEN1)'["A"
- QUIT
- +33 SET PSJAND=$LENGTH($PIECE(PSJOVR("STRING"),"T",PSJTHEN1),"A")
- +34 SET PSJAND1=""
- FOR PSJAND1=1:1:PSJAND
- Begin DoDot:3
- +35 SET PSJAND(PSJTHEN1,PSJAND1)=$PIECE($PIECE(PSJOVR("STRING"),"T",PSJTHEN1),"A",PSJAND1)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 DO CHK2
- DO EXIT
- +37 QUIT
- CHK ;
- +1 IF 'CNT
- QUIT
- +2 KILL PSJADOVR
- +3 SET X=""
- +4 FOR X=1:1:CNT
- Begin DoDot:1
- +5 SET X2=""
- FOR
- SET X2=$ORDER(PSJADOV(X2))
- IF X2=""
- QUIT
- Begin DoDot:2
- +6 SET X3=""
- FOR
- SET X3=$ORDER(PSJADOV(X2,X3))
- IF X3=""
- QUIT
- Begin DoDot:3
- +7 IF $DATA(PSJADOV(X2+X,X3))
- SET $PIECE(^TMP("PSJATOVR",$JOB,X2),"^",4)=1
- SET $PIECE(^TMP("PSJATOVR",$JOB,X2+X),"^",4)=1
- SET PSJOVRLP=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 QUIT
- +9 ;
- CHK2 ;
- +1 IF '$GET(PSJAND1)
- QUIT
- +2 SET (X,X1,X2,X3,X4,PSJZT)=""
- +3 KILL PSJADOVR
- +4 FOR X=1:1:PSJAND1
- Begin DoDot:1
- +5 SET X2=""
- FOR
- SET X2=$ORDER(PSJAND(X2))
- IF X2=""
- QUIT
- Begin DoDot:2
- +6 SET X3=""
- FOR
- SET X3=$ORDER(PSJAND(X2,X3))
- IF X3=""
- QUIT
- Begin DoDot:3
- +7 SET X4=$GET(PSJAND(X2,X3))
- +8 IF X4=""
- QUIT
- +9 MERGE PSJADOVR(X2,X3,X4)=PSJADOV(X4)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 FOR PSJZT=1:1:PSJAND1
- Begin DoDot:1
- +11 SET X=""
- FOR
- SET X=$ORDER(PSJADOVR(X))
- IF X=""
- QUIT
- Begin DoDot:2
- +12 SET X1=""
- FOR
- SET X1=$ORDER(PSJADOVR(X,X1))
- IF X1=""
- QUIT
- Begin DoDot:3
- +13 SET X2=""
- FOR
- SET X2=$ORDER(PSJADOVR(X,X1,X2))
- IF X2=""
- QUIT
- Begin DoDot:4
- +14 SET X3=""
- FOR
- SET X3=$ORDER(PSJADOVR(X,X1,X2,X3))
- IF X3=""
- QUIT
- Begin DoDot:5
- +15 IF $DATA(PSJADOVR(X,X1+PSJZT,X2+PSJZT,X3))
- SET $PIECE(^TMP("PSJATOVR",$JOB,X2),"^",4)=1
- SET $PIECE(^TMP("PSJATOVR",$JOB,X2+PSJZT),"^",4)=1
- SET PSJOVRLP=1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- BUILD ;
- +1 SET X=""
- FOR
- SET X=$ORDER(PSJOVR("SCHEDULE",X))
- IF X=""
- QUIT
- SET ^TMP("PSJATOVR",$JOB,X)=X_"^"_$GET(PSJOVR("SCHEDULE",X))
- +2 SET X=""
- FOR
- SET X=$ORDER(PSJOVR("ADMIN",X))
- IF X=""
- QUIT
- SET ^TMP("PSJATOVR",$JOB,X)=^TMP("PSJATOVR",$JOB,X)_"^"_$GET(PSJOVR("ADMIN",X))_"^0"
- +3 QUIT
- +4 ;
- EXIT ; Kill variables
- +1 KILL PSJAND,PSJAND1,PSJTHEN,PSJTHEN1,PSJADOVR,PSJADOV,PSJADOV2
- +2 KILL X,X1,X2,X3,X4,PSJZT,TOTCONJ,CNT,PSJORDLG
- +3 QUIT
