PSGPLFM.m

PSGPLFM ;BIR/CML3-SENDS 'NO DRUG COST FOUND' MAILMAN MSG ;16 DEC 97 / 1:37 PM 

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

NCMSG ;

 S NCF=2,QQ="" F  S QQ=$O(^TMP("PSGNCF",$J,"B",QQ)) Q:'QQ  S NCF=NCF+1,^TMP("PSGNCF",$J,NCF,0)="         "_$S(QQ[",":QQ,1:$$ENDDN^PSGMI(QQ))

 K ^TMP("PSGNCF",$J,"B") S XMSUB="COST NOT FOUND ON DRUG ITEM"_$E("S",NCF>3),XMTEXT="^TMP(""PSGNCF"",$J,",XMDUZ="MEDICATIONS,UNIT DOSE" ; I 'XMDUZ D ENNU S XMDUZ=$O(^VA(200,"B","MEDICATIONS,UNIT DOSE",0))

 K XMY F Q=0:0 S Q=$O(^XUSEC("PSJU MGR",Q)) Q:'Q  S XMY(Q)=1

 I '$D(XMY) F Q=0:0 S Q=$O(^XUSEC("PSJ RPHARM",Q)) Q:'Q  S XMY(Q)=1

 S:$D(DUZ)#2 XMY(+DUZ)=1 S ^TMP("PSGNCF",$J,1,0)="   The following item"_$E("s",NCF>3)_" from your DRUG file "_$P("was^were","^",NCF>3+1)_" found to have NO DATA in "_$P("its^their","^",NCF>3+1)

 S ^TMP("PSGNCF",$J,2,0)="PRICE PER DISPENSE UNIT field:"

 S ^TMP("PSGNCF",$J,NCF+1,0)=" ",^TMP("PSGNCF",$J,NCF+2,0)="   Any PICK LIST with "_$P("this item^any of these items","^",NCF>3+1)_" will NOT be completely FILED AWAY"_$P(" until^","^",NCF>3+1)

 S ^TMP("PSGNCF",$J,NCF+3,0)=$P("^until ","^",NCF>3+1)_"the PRICE PER DISPENSE UNIT field has been entered into for "_$P("this^these","^",NCF>3+1)_" item"_$E("s",NCF>3)_"."

 S ^TMP("PSGNCF",$J,NCF+4,0)="   Even if there is no cost for "_$P("this^these","^",NCF>3+1)_" item"_$E("s",NCF>3)_", a zero (0) must be entered into"

 S ^TMP("PSGNCF",$J,NCF+5,0)="the PRICE PER DISPENSE UNIT field so the package knows it is not an error"

 S ^TMP("PSGNCF",$J,NCF+6,0)="or an omission.  UNTIL THIS IS DONE, NO COST REPORT WILL BE ACCURATE, AND ANY"

 S ^TMP("PSGNCF",$J,NCF+7,0)="PICK LIST WITH "_$P("THIS^THESE","^",NCF>3+1)_" ITEM"_$E("S",NCF>3)_" CANNOT BE PURGED." D ^XMD

 ;

DONE ;

 K NCF,QQ,XMDUZ,XMSUB,XMTEXT,^TMP("PSGNCF",$J) Q

PSGPLFM   ;BIR/CML3-SENDS 'NO DRUG COST FOUND' MAILMAN MSG ;16 DEC 97 / 1:37 PM 

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ;

NCMSG     ;

 +1        SET NCF=2

           SET QQ=""

           FOR 

               SET QQ=$ORDER(^TMP("PSGNCF",$JOB,"B",QQ))

               IF 'QQ

                   QUIT 

               SET NCF=NCF+1

               SET ^TMP("PSGNCF",$JOB,NCF,0)="         "_$SELECT(QQ[",":QQ,1:$$ENDDN^PSGMI(QQ))

 +2       ; I 'XMDUZ D ENNU S XMDUZ=$O(^VA(200,"B","MEDICATIONS,UNIT DOSE",0))

           KILL ^TMP("PSGNCF",$JOB,"B")

           SET XMSUB="COST NOT FOUND ON DRUG ITEM"_$EXTRACT("S",NCF>3)

           SET XMTEXT="^TMP(""PSGNCF"",$J,"

           SET XMDUZ="MEDICATIONS,UNIT DOSE"

 +3        KILL XMY

           FOR Q=0:0

               SET Q=$ORDER(^XUSEC("PSJU MGR",Q))

               IF 'Q

                   QUIT 

               SET XMY(Q)=1

 +4        IF '$DATA(XMY)

               FOR Q=0:0

                   SET Q=$ORDER(^XUSEC("PSJ RPHARM",Q))

                   IF 'Q

                       QUIT 

                   SET XMY(Q)=1

 +5        IF $DATA(DUZ)#2

               SET XMY(+DUZ)=1

           SET ^TMP("PSGNCF",$JOB,1,0)="   The following item"_$EXTRACT("s",NCF>3)_" from your DRUG file "_$PIECE("was^were","^",NCF>3+1)_" found to have NO DATA in "_$PIECE("its^their","^",NCF>3+1)

 +6        SET ^TMP("PSGNCF",$JOB,2,0)="PRICE PER DISPENSE UNIT field:"

 +7        SET ^TMP("PSGNCF",$JOB,NCF+1,0)=" "

           SET ^TMP("PSGNCF",$JOB,NCF+2,0)="   Any PICK LIST with "_$PIECE("this item^any of these items","^",NCF>3+1)_" will NOT be completely FILED AWAY"_$PIECE(" until^","^",NCF>3+1)

 +8        SET ^TMP("PSGNCF",$JOB,NCF+3,0)=$PIECE("^until ","^",NCF>3+1)_"the PRICE PER DISPENSE UNIT field has been entered into for "_$PIECE("this^these","^",NCF>3+1)_" item"_$EXTRACT("s",NCF>3)_"."

 +9        SET ^TMP("PSGNCF",$JOB,NCF+4,0)="   Even if there is no cost for "_$PIECE("this^these","^",NCF>3+1)_" item"_$EXTRACT("s",NCF>3)_", a zero (0) must be entered into"

 +10       SET ^TMP("PSGNCF",$JOB,NCF+5,0)="the PRICE PER DISPENSE UNIT field so the package knows it is not an error"

 +11       SET ^TMP("PSGNCF",$JOB,NCF+6,0)="or an omission.  UNTIL THIS IS DONE, NO COST REPORT WILL BE ACCURATE, AND ANY"

 +12       SET ^TMP("PSGNCF",$JOB,NCF+7,0)="PICK LIST WITH "_$PIECE("THIS^THESE","^",NCF>3+1)_" ITEM"_$EXTRACT("S",NCF>3)_" CANNOT BE PURGED."

           DO ^XMD

 +13      ;

DONE      ;

 +1        KILL NCF,QQ,XMDUZ,XMSUB,XMTEXT,^TMP("PSGNCF",$JOB)

           QUIT