PSSP254R ;BIRM/SA - PSS*1*254 Reports ; Aug 03, 2022@16:00
;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
;
; Reference to FINDQO^ORQOUTL supported by IA #7349
;
EN ; entry point
K ^TMP("PSSP254R",$J)
N ARRAY,CNT,DLG,DOSEFORM,ENTRY,FLD,FLE,FREQOLD,FREQNEW,IEN,INPUT,II,MEDSCH,MSG,NUM,NODE,NODE0
N OD,ODLIST,ORDIEN,OR0,ORSNODE,ORSTEXT,PSSI,SUB
;
S MSG="",CNT=1
S ^TMP("PSSP254R",$J,CNT)="The Dosing Check Frequency field conversion may have impacted Orderable Items.",CNT=CNT+1
S ^TMP("PSSP254R",$J,CNT)="Schedule^Old Freq^New Freq^Record Num (IEN)^Name^Dosage Form",CNT=CNT+1
;
S FLE=0 F S FLE=$O(^XTMP("PSSP254B","DCF",FLE)) Q:'FLE D
.S NUM=0 F S NUM=$O(^XTMP("PSSP254B","DCF",FLE,NUM)) Q:'NUM S FLD=$O(^XTMP("PSSP254B","DCF",FLE,NUM,0)) D
..S NODE=$G(^XTMP("PSSP254B","DCF",FLE,NUM,FLD)),ENTRY=$$GET1^DIQ(FLE,NUM,.01)
..S FREQOLD=$E($P(NODE,U,1),1,5),FREQNEW=$E($P(NODE,U,2),1,5)
..D CHK
;
;No impacted items
I CNT=3 S ^TMP("PSSP254R",$J,CNT)="",^TMP("PSSP254R",$J,CNT+1)="There were no impacted Orderable Items"
;
D MAIL("Orderable Items Report")
D QO
;
K ^TMP("PSSP254R",$J),^TMP($J)
Q
;
CHK ; check if the modified schedule entry was used in file #50.7 entries
S PSSI=0 F S PSSI=$O(^PS(50.7,PSSI)) Q:'PSSI S NODE0=$G(^PS(50.7,PSSI,0)),MEDSCH=$P(NODE0,U,8) I MEDSCH'="" D
.I ENTRY=MEDSCH D
..S DOSEFORM=$$GET1^DIQ(50.606,$P(NODE0,U,2),.01)
..S ^TMP("PSSP254R",$J,CNT)=ENTRY_U_FREQOLD_U_FREQNEW_U_PSSI_U_$P(NODE0,U)_U_DOSEFORM
..;
..;If the entry is more than 78 characters, truncate the schedule to 15, orderable item name to 30, and dosage form to 10
..;The two frequency fields are already limited to 5 characters
..I $L(^TMP("PSSP254R",$J,CNT))>78 D
...S ^TMP("PSSP254R",$J,CNT)=$E(ENTRY,1,15)_U_FREQOLD_U_FREQNEW_U_$E(PSSI,1,7)_U_$E($P(NODE0,U),1,30)_U_$E(DOSEFORM,1,10)
..S CNT=CNT+1
Q
;
QO ; quick orders report
N FREQNEW,FREQOLD,RDISP
;
K ^TMP("PSSP254R",$J),^TMP($J)
;
; ODLIST(QO entry)=Display Group^Package
S ODLIST("PSO OERR")="OUTPATIENT MEDICATIONS^OUTPATIENT PHARMACY"
S ODLIST("PSJ OR PAT OE")="UNIT DOSE MEDICATIONS^INPATIENT MEDICATIONS"
S ODLIST("PSJ OR CLINIC OE")="CLINIC MEDICATIONS^INPATIENT MEDICATIONS"
S ODLIST("PSJI OR PAT FLUID OE")="IV MEDICATIONS^INPATIENT MEDICATIONS"
S ODLIST("CLINIC OR PAT FLUID OE")="CLINIC INFUSIONS^INPATIENT MEDICATIONS"
S ODLIST("PSH OERR")="NON-VA MEDICATIONS^HERBAL/OTC/NON-VA MEDS"
S ODLIST("PS MEDS")="PHARMACY^PHARMACY DATA MANAGEMENT"
;
;For display in the email - RDISP(QO entry)=Display Text (for Display Group)
; Values are locked to 8 characters max
S RDISP("PSO OERR")="OP"
S RDISP("PSJ OR PAT OE")="UD"
S RDISP("PSJ OR CLINIC OE")="CLIN MED"
S RDISP("PSJI OR PAT FLUID OE")="IV"
S RDISP("CLINIC OR PAT FLUID OE")="CLIN INF"
S RDISP("PSH OERR")="NON-VA"
S RDISP("PS MEDS")="PHARM"
;
S CNT=1,FLE=0
S ^TMP("PSSP254R",$J,CNT)="The Dosing Check Frequency field conversion may have impacted Quick Orders.",CNT=CNT+1
S ^TMP("PSSP254R",$J,CNT)="Schedule^Old Freq^New Freq^Record Num (IEN)^Name^Display Group",CNT=CNT+1
;S ^TMP("PSSP254R",$J,CNT)="",CNT=CNT+1
;
;Quick Orders are file 51 only
;F S FLE=$O(^XTMP("PSSP254B","DCF",FLE)) Q:'FLE D
S FLE=51 D
.S NUM=0 F S NUM=$O(^XTMP("PSSP254B","DCF",FLE,NUM)) Q:'NUM S FLD=$O(^XTMP("PSSP254B","DCF",FLE,NUM,0)) D
..S NODE=$G(^XTMP("PSSP254B","DCF",FLE,NUM,FLD)),ENTRY=$$GET1^DIQ(FLE,NUM,.01)
..S FREQOLD=$E($P(NODE,U,1),1,5),FREQNEW=$E($P(NODE,U,2),1,5)
..D CHKQO
;
;No impacted items
I CNT=3 S ^TMP("PSSP254R",$J,CNT)="",^TMP("PSSP254R",$J,CNT+1)="There were no impacted Quick Orders"
;
D MAIL("Quick Orders Report")
Q
;
CHKQO ; check if the modified schedule entry was used in file #101.41 entries
S SUB="ARR"
;
S OD="" F S OD=$O(ODLIST(OD)) Q:OD="" D
. K DLG,^TMP($J,SUB)
. S DLG(OD)=""
. I $$PATCH^XPDUTL("OR*3.0*405") D FINDQO^ORQOUTL(.ARRAY,.DLG,SUB,0,1,0,0) ; CPRS v32B
. E D FINDQO^ORQOUTL(.ARRAY,.DLG,SUB,0,1) ; CPRS v31B
. D SET
Q
;
SET ;
S IEN=0 F S IEN=$O(^TMP($J,SUB,IEN)) Q:IEN'>0 S ORDIEN=+$G(^TMP($J,SUB,IEN,"ORDIALOG")) D:ORDIEN
. S OR0=$G(^TMP($J,SUB,IEN))
. S ORSNODE=$P($G(^TMP($J,SUB,IEN,"ORDIALOG","B","SCHEDULE")),U,2) I ORSNODE D
.. S ORSTEXT=$G(^TMP($J,SUB,IEN,"ORDIALOG",ORSNODE,1)) I ORSTEXT'="",(ENTRY=ORSTEXT) D
... S ^TMP("PSSP254R",$J,CNT)=$E(ENTRY,1,10)_U_FREQOLD_U_FREQNEW_U_$E(IEN,1,7)_U_$E($P(OR0,U),1,36)_U_RDISP(OD) S CNT=CNT+1
Q
;
MAIL(TEXT) ; Sends Mailman message
N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
D BMES^XPDUTL("Sending Mailman Message for "_TEXT_"...")
S II=0 F S II=$O(^XUSEC("PSNMGR",II)) Q:'II S XMY(II)=""
S XMY(DUZ)="",XMSUB="PSS*1*254 - "_TEXT
S XMDUZ="PSS*1*254 Install",XMTEXT="^TMP(""PSSP254R"",$J,"
D ^XMD K ^TMP("PSSP254R",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP254R 4843 printed Aug 26, 2025@22:49:12 Page 2
PSSP254R ;BIRM/SA - PSS*1*254 Reports ; Aug 03, 2022@16:00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
+2 ;
+3 ; Reference to FINDQO^ORQOUTL supported by IA #7349
+4 ;
EN ; entry point
+1 KILL ^TMP("PSSP254R",$JOB)
+2 NEW ARRAY,CNT,DLG,DOSEFORM,ENTRY,FLD,FLE,FREQOLD,FREQNEW,IEN,INPUT,II,MEDSCH,MSG,NUM,NODE,NODE0
+3 NEW OD,ODLIST,ORDIEN,OR0,ORSNODE,ORSTEXT,PSSI,SUB
+4 ;
+5 SET MSG=""
SET CNT=1
+6 SET ^TMP("PSSP254R",$JOB,CNT)="The Dosing Check Frequency field conversion may have impacted Orderable Items."
SET CNT=CNT+1
+7 SET ^TMP("PSSP254R",$JOB,CNT)="Schedule^Old Freq^New Freq^Record Num (IEN)^Name^Dosage Form"
SET CNT=CNT+1
+8 ;
+9 SET FLE=0
FOR
SET FLE=$ORDER(^XTMP("PSSP254B","DCF",FLE))
if 'FLE
QUIT
Begin DoDot:1
+10 SET NUM=0
FOR
SET NUM=$ORDER(^XTMP("PSSP254B","DCF",FLE,NUM))
if 'NUM
QUIT
SET FLD=$ORDER(^XTMP("PSSP254B","DCF",FLE,NUM,0))
Begin DoDot:2
+11 SET NODE=$GET(^XTMP("PSSP254B","DCF",FLE,NUM,FLD))
SET ENTRY=$$GET1^DIQ(FLE,NUM,.01)
+12 SET FREQOLD=$EXTRACT($PIECE(NODE,U,1),1,5)
SET FREQNEW=$EXTRACT($PIECE(NODE,U,2),1,5)
+13 DO CHK
End DoDot:2
End DoDot:1
+14 ;
+15 ;No impacted items
+16 IF CNT=3
SET ^TMP("PSSP254R",$JOB,CNT)=""
SET ^TMP("PSSP254R",$JOB,CNT+1)="There were no impacted Orderable Items"
+17 ;
+18 DO MAIL("Orderable Items Report")
+19 DO QO
+20 ;
+21 KILL ^TMP("PSSP254R",$JOB),^TMP($JOB)
+22 QUIT
+23 ;
CHK ; check if the modified schedule entry was used in file #50.7 entries
+1 SET PSSI=0
FOR
SET PSSI=$ORDER(^PS(50.7,PSSI))
if 'PSSI
QUIT
SET NODE0=$GET(^PS(50.7,PSSI,0))
SET MEDSCH=$PIECE(NODE0,U,8)
IF MEDSCH'=""
Begin DoDot:1
+2 IF ENTRY=MEDSCH
Begin DoDot:2
+3 SET DOSEFORM=$$GET1^DIQ(50.606,$PIECE(NODE0,U,2),.01)
+4 SET ^TMP("PSSP254R",$JOB,CNT)=ENTRY_U_FREQOLD_U_FREQNEW_U_PSSI_U_$PIECE(NODE0,U)_U_DOSEFORM
+5 ;
+6 ;If the entry is more than 78 characters, truncate the schedule to 15, orderable item name to 30, and dosage form to 10
+7 ;The two frequency fields are already limited to 5 characters
+8 IF $LENGTH(^TMP("PSSP254R",$JOB,CNT))>78
Begin DoDot:3
+9 SET ^TMP("PSSP254R",$JOB,CNT)=$EXTRACT(ENTRY,1,15)_U_FREQOLD_U_FREQNEW_U_$EXTRACT(PSSI,1,7)_U_$EXTRACT($PIECE(NODE0,U),1,30)_U_$EXTRACT(DOSEFORM,1,10)
End DoDot:3
+10 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
QO ; quick orders report
+1 NEW FREQNEW,FREQOLD,RDISP
+2 ;
+3 KILL ^TMP("PSSP254R",$JOB),^TMP($JOB)
+4 ;
+5 ; ODLIST(QO entry)=Display Group^Package
+6 SET ODLIST("PSO OERR")="OUTPATIENT MEDICATIONS^OUTPATIENT PHARMACY"
+7 SET ODLIST("PSJ OR PAT OE")="UNIT DOSE MEDICATIONS^INPATIENT MEDICATIONS"
+8 SET ODLIST("PSJ OR CLINIC OE")="CLINIC MEDICATIONS^INPATIENT MEDICATIONS"
+9 SET ODLIST("PSJI OR PAT FLUID OE")="IV MEDICATIONS^INPATIENT MEDICATIONS"
+10 SET ODLIST("CLINIC OR PAT FLUID OE")="CLINIC INFUSIONS^INPATIENT MEDICATIONS"
+11 SET ODLIST("PSH OERR")="NON-VA MEDICATIONS^HERBAL/OTC/NON-VA MEDS"
+12 SET ODLIST("PS MEDS")="PHARMACY^PHARMACY DATA MANAGEMENT"
+13 ;
+14 ;For display in the email - RDISP(QO entry)=Display Text (for Display Group)
+15 ; Values are locked to 8 characters max
+16 SET RDISP("PSO OERR")="OP"
+17 SET RDISP("PSJ OR PAT OE")="UD"
+18 SET RDISP("PSJ OR CLINIC OE")="CLIN MED"
+19 SET RDISP("PSJI OR PAT FLUID OE")="IV"
+20 SET RDISP("CLINIC OR PAT FLUID OE")="CLIN INF"
+21 SET RDISP("PSH OERR")="NON-VA"
+22 SET RDISP("PS MEDS")="PHARM"
+23 ;
+24 SET CNT=1
SET FLE=0
+25 SET ^TMP("PSSP254R",$JOB,CNT)="The Dosing Check Frequency field conversion may have impacted Quick Orders."
SET CNT=CNT+1
+26 SET ^TMP("PSSP254R",$JOB,CNT)="Schedule^Old Freq^New Freq^Record Num (IEN)^Name^Display Group"
SET CNT=CNT+1
+27 ;S ^TMP("PSSP254R",$J,CNT)="",CNT=CNT+1
+28 ;
+29 ;Quick Orders are file 51 only
+30 ;F S FLE=$O(^XTMP("PSSP254B","DCF",FLE)) Q:'FLE D
+31 SET FLE=51
Begin DoDot:1
+32 SET NUM=0
FOR
SET NUM=$ORDER(^XTMP("PSSP254B","DCF",FLE,NUM))
if 'NUM
QUIT
SET FLD=$ORDER(^XTMP("PSSP254B","DCF",FLE,NUM,0))
Begin DoDot:2
+33 SET NODE=$GET(^XTMP("PSSP254B","DCF",FLE,NUM,FLD))
SET ENTRY=$$GET1^DIQ(FLE,NUM,.01)
+34 SET FREQOLD=$EXTRACT($PIECE(NODE,U,1),1,5)
SET FREQNEW=$EXTRACT($PIECE(NODE,U,2),1,5)
+35 DO CHKQO
End DoDot:2
End DoDot:1
+36 ;
+37 ;No impacted items
+38 IF CNT=3
SET ^TMP("PSSP254R",$JOB,CNT)=""
SET ^TMP("PSSP254R",$JOB,CNT+1)="There were no impacted Quick Orders"
+39 ;
+40 DO MAIL("Quick Orders Report")
+41 QUIT
+42 ;
CHKQO ; check if the modified schedule entry was used in file #101.41 entries
+1 SET SUB="ARR"
+2 ;
+3 SET OD=""
FOR
SET OD=$ORDER(ODLIST(OD))
if OD=""
QUIT
Begin DoDot:1
+4 KILL DLG,^TMP($JOB,SUB)
+5 SET DLG(OD)=""
+6 ; CPRS v32B
IF $$PATCH^XPDUTL("OR*3.0*405")
DO FINDQO^ORQOUTL(.ARRAY,.DLG,SUB,0,1,0,0)
+7 ; CPRS v31B
IF '$TEST
DO FINDQO^ORQOUTL(.ARRAY,.DLG,SUB,0,1)
+8 DO SET
End DoDot:1
+9 QUIT
+10 ;
SET ;
+1 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,SUB,IEN))
if IEN'>0
QUIT
SET ORDIEN=+$GET(^TMP($JOB,SUB,IEN,"ORDIALOG"))
if ORDIEN
Begin DoDot:1
+2 SET OR0=$GET(^TMP($JOB,SUB,IEN))
+3 SET ORSNODE=$PIECE($GET(^TMP($JOB,SUB,IEN,"ORDIALOG","B","SCHEDULE")),U,2)
IF ORSNODE
Begin DoDot:2
+4 SET ORSTEXT=$GET(^TMP($JOB,SUB,IEN,"ORDIALOG",ORSNODE,1))
IF ORSTEXT'=""
IF (ENTRY=ORSTEXT)
Begin DoDot:3
+5 SET ^TMP("PSSP254R",$JOB,CNT)=$EXTRACT(ENTRY,1,10)_U_FREQOLD_U_FREQNEW_U_$EXTRACT(IEN,1,7)_U_$EXTRACT($PIECE(OR0,U),1,36)_U_RDISP(OD)
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
MAIL(TEXT) ; Sends Mailman message
+1 NEW II,XMX,XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
+2 DO BMES^XPDUTL("Sending Mailman Message for "_TEXT_"...")
+3 SET II=0
FOR
SET II=$ORDER(^XUSEC("PSNMGR",II))
if 'II
QUIT
SET XMY(II)=""
+4 SET XMY(DUZ)=""
SET XMSUB="PSS*1*254 - "_TEXT
+5 SET XMDUZ="PSS*1*254 Install"
SET XMTEXT="^TMP(""PSSP254R"",$J,"
+6 DO ^XMD
KILL ^TMP("PSSP254R",$JOB)
+7 QUIT
