Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSAPRE71

PSAPRE71.m

Go to the documentation of this file.
PSAPRE71  ;BIR/RJS-PRE-INSTALL TO IDENTIFY BAD 58.8 DRUG POINTERS
 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**71**;;Build 10
 ;;
 N X1,X2,Y,PSADT,PSALOC,PSADAT,PSADRG,PSACNTR,PSAFND,PSAIEN,PSAIN,PSAINV,PSAORD,PSAPRO,PSARDT,PSAROU,PSAVDT,PSAVER,XMDUZ,XMSUB,XMTEXT,XMY
 S PSAROU="PSALCK"
 S PSACNTR=1,PSAFND=0
 S ^TMP($J,PSAROU,PSACNTR)="The following Drug Accountability Order Invoices currently",PSACNTR=PSACNTR+1
 S ^TMP($J,PSAROU,PSACNTR)="have a status of LOCKED VERIFYING.",PSACNTR=PSACNTR+1
 S ^TMP($J,PSAROU,PSACNTR)=" ",PSACNTR=PSACNTR+1
 S PSADAT="" D TXT("Order#",1),TXT("Invoice#",20),TXT("Date Received",40),TXT("Verifier",60)
 S ^TMP($J,PSAROU,PSACNTR)=PSADAT,PSACNTR=PSACNTR+1
 S PSAIEN=0 F  S PSAIEN=$O(^PSD(58.811,"ASTAT","L",PSAIEN)) Q:'PSAIEN  D
 .S PSAINV=0 F  S PSAINV=$O(^PSD(58.811,"ASTAT","L",PSAIEN,PSAINV)) Q:'PSAINV  D
 ..S PSAVDT=+$P(^PSD(58.811,PSAIEN,1,PSAINV,1,1,0),"^",8),PSARDT=+$P(^PSD(58.811,PSAIEN,1,PSAINV,0),"^",7)
 ..S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^",1),PSAIN=$P(^PSD(58.811,PSAIEN,1,PSAINV,0),"^",1)
 ..S Y=PSARDT D DD^%DT S PSADT=Y
 ..I '$P($G(^PSD(58.811,PSAIEN,1,PSAINV,0)),"^",11) D UNLCK Q
 ..S PSAVER=$P(^VA(200,$P(^PSD(58.811,PSAIEN,1,PSAINV,0),"^",11),0),"^",1)
 ..S PSADAT="" D TXT(PSAORD,1),TXT(PSAIN,20),TXT(PSADT,40),TXT(PSAVER,60)
 ..S ^TMP($J,PSAROU,PSACNTR)=PSADAT,PSACNTR=PSACNTR+1,PSAFND=1
 ..S ^XTMP(PSAROU,$P(^PSD(58.811,PSAIEN,1,PSAINV,0),"^",11),PSAIEN,PSAINV)=""
 I $G(PSAFND) S X1=DT,X2=60 D C^%DTC S ^XTMP(PSAROU,0)=X_"^"_DT_"^PSA*3*71 LOCKED INVOICES"
 I 'PSAFND S ^TMP($J,PSAROU,PSACNTR)="No Locked Invoices Found.",PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="",PSACNTR=PSACNTR+1
 S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="",PSACNTR=PSACNTR+1
 S XMSUB="PSA*3*71 LOCKED INVOICE REPORT",XMDUZ="PSA*3*71 PREINSTALL"
 D MAIL
 S PSAROU="PSACHK"
 D NOW^%DTC S Y=% D DD^%DT S PSADT=$P(Y,"@",1)_" at "_$P(Y,"@",2)
 S ^TMP(PSAROU,$J,0)=PSADT
 S PSALOC=0 F  S PSALOC=$O(^PSD(58.8,PSALOC)) Q:'PSALOC  D
 .S PSADRG=99999999 F  S PSADRG=$O(^PSD(58.8,PSALOC,1,PSADRG)) Q:PSADRG=""  D
 ..Q:PSADRG="B"
 ..I $L(PSADRG)'=$L(+PSADRG) S ^TMP(PSAROU,$J,PSALOC,PSADRG)="" K ^PSD(58.8,PSALOC,1,PSADRG,0)
 S XMSUB="PSA*3*71 PREINSTALL BAD 58.8 RECORD REPORT",XMDUZ="PSA*3*71 PREINSTALL"
 S PSACNTR=1,^TMP($J,PSAROU,PSACNTR)="PSA*3*71 PREINSTALL Bad PSD(58.8 Record Report for "_PSADT,PSACNTR=PSACNTR+1
 S ^TMP($J,PSAROU,PSACNTR)=" ",PSACNTR=PSACNTR+1
 I '$O(^TMP(PSAROU,$J,0)) S ^TMP($J,PSAROU,PSACNTR)="No Bad Records found.",PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="",PSACNTR=PSACNTR+1 G MAIL
 S PSALOC=0 F  S PSALOC=$O(^TMP(PSAROU,$J,PSALOC)) Q:'PSALOC  D
 .S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)=$P(^PSD(58.8,PSALOC,0),"^")
 .S PSADRG=0 F  S PSADRG=$O(^TMP(PSAROU,$J,PSALOC,PSADRG)) Q:PSADRG=""  D
 ..S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="     "_PSADRG
 .S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="",PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="   *** These have been removed from the file.***",PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)=""
 S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="",PSACNTR=PSACNTR+1
MAIL N DIFROM
 S PSACNTR=PSACNTR+1,^TMP($J,PSAROU,PSACNTR)="***** End Of Report *****"
 S XMTEXT="^TMP($J,"""_PSAROU_""","
 S XMY("G.PSA NDC UPDATES")=""
 D ^XMD
 Q
EXIT ; CLEAN UP
 K ^TMP($J),^TMP(PSAROU)
 Q
TXT(PSAVAL,PSACOL) S:'$D(PSADAT) PSADAT="" S PSADAT=$$SETSTR^VALM1(PSAVAL,PSADAT,PSACOL,$L(PSAVAL)) Q
 Q
UNLCK ; UNLOCK BACK LOCK
 F  L +^PSD(58.811,PSAIEN,1,PSAINV,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
 S DA=PSAINV,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P" D ^DIE
 L -^PSD(58.811,PSAIEN,1,PSAINV,0)
 Q