- PSAPTCH ;BHM/DAV - FIND INVOICES PROCESSED BY CONTROLLED SUBS;
- ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,73**; 10/24/97;Build 3
- ;CS() = array contains item numbers of processed CS invoice
- ;PSACSERR =error flag set
- ;
- D Q
- ;
- 1 ;Check for uploaded CS invoice
- ;PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
- S PSAUPORD=$P(PSAIN,"^",4) ;Incoming Order Number
- S PSAUPINV=$P(PSAIN,"^",2) ;Incoming Invoice Number
- I '$D(^XTMP("PSAPV",PSACTRL,"IT")) K ^XTMP("PSAPV",PSACTRL) S PSAINVDL=1 Q
- I $G(PSAUPORD)="" K ^XTMP("PSAPV",PSACTRL) S PSAINVDL=1 Q
- I $G(PSAUPINV)="" K ^XTMP("PSAPV",PSACTRL) S PSAINVDL=1 Q
- I $L(PSAIN)'>10 K ^XTMP("PSAPV",PSACTRL) S PSAINVDL=1 Q
- S Y=$P(PSAIN,"^",1) X ^DD("DD") S PSAUPDT1=Y ;Invoice Date
- S Y=$P(PSAIN,"^",3) X ^DD("DD") S PSAUPDT2=Y ;Order Date
- S INVITM=0 F S INVITM=$O(^XTMP("PSAPV",PSACTRL,"IT",INVITM)) Q:INVITM'>0 S INV(INVITM)=^XTMP("PSAPV",PSACTRL,"IT",INVITM),INVCNT=INVITM
- I '$D(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV)) G Q
- K PSAORD,ORDIEN,INVIEN,CSINV
- S ORDIEN=$O(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV,0)) ;Order # IEN
- S INVIEN=$O(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV,ORDIEN,0)) ;Invoice # IEN
- S PSDCNT=0,X=0 F S X=$O(^PSD(58.811,ORDIEN,1,INVIEN,1,X)) Q:X'>0 S PSDCNT=$G(PSDCNT)+1
- I INVCNT=PSDCNT K ^XTMP("PSAPV",PSACTRL) Q
- W @IOF,!,"** WARNING **",!!,"P.O. Number : ",PSAUPORD,!,"Invoice Number : ",PSAUPINV,!
- ;
- S PSASTAS=$P($G(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",3),PSASTAS=$S(PSASTAS="P":"PROCESSED",PSASTAS="V":"VERIFIED",PSASTAS="C":"COMPLETED",1:"UNKNOWN")
- W !,"Incoming",?40,"Already Marked as "_" * "_PSASTAS_" *",!,"Invoice file",?40,"in Drug Accountability Order file",! F X=1:1:(IOM-1) W "="
- S Y=$P($G(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",4) X ^DD("DD") W !,PSAUPDT2,?16," <-- Order Date --> ",?40,Y
- S Y=$P($G(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",2) X ^DD("DD") W !,PSAUPDT1,?15," <-- Invoice Date --> ",?40,Y
- CHECK W !,?3,$J($G(INVCNT),8),?16," <-- Line Items -->",?40,$G(PSDCNT),!!
- ;
- CMPRE R !,"Do you want to compare item? NO// ",AN:DTIME I AN["^"!(AN="") G ASK
- S AN=$E(AN) I "yYnN"'[AN W !,"Answer 'Y'es to display the items from the invoice file, as well as the items",!,"already uploaded.",! G CMPRE
- I "nN"[AN G ASK
- S X=0 F S X=$O(^XTMP("PSAPV",PSACTRL,"IT",X)) Q:X="" S DATA=$G(^XTMP("PSAPV",PSACTRL,"IT",X)),PSAITM(X)=DATA
- S X=0 F S X=$O(^PSD(58.811,ORDIEN,1,INVIEN,1,X)) Q:X="" S DATA=$G(^PSD(58.811,ORDIEN,1,INVIEN,1,X,0)),PSAUPITM(+DATA)=DATA
- S:INVCNT'=PSDCNT $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="OK"
- G Q
- ;
- ASK R !!,"Do you want to delete the incoming invoice ? NO// ",AN:DTIME G Q:AN["^" I "Nn"[AN G Q
- I "?"[AN W !!,"Answer 'Y'es, and the incoming invoice will be deleted.",! G ASK
- I AN="" G Q
- I "Yy"[AN K ^XTMP("PSAPV",PSACTRL) S PSAINVDL=1 Q
- ;
- ;Kill incoming invoice.
- Q K AN,CS,CSCNT,CSIEN,CSINV,DATA,FOUND,INV,INVCNT,INVDEL,INVIEN,INVITM,LINEITM,ORDIEN,PSAORD,PSAUPDT1,PSAUPDT2,PSAUPINV,PSAUPORD,PSDCNT,X,XX,Y Q
- PSAOLD ;Entry point for deleting old invoices
- I '$D(^XTMP("PSAPV")) W !,"Sorry, there aren't any invoices on file." G Q
- ASKDT S %DT="A",%DT("A")="Delete invoices older than what date: " D ^%DT
- I Y'<DT W !,"Sorry, the date has to be in the past." K Y G ASKDT
- S PSAKLDT=Y
- ;
- S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL'>0 S DATA=$G(^XTMP("PSAPV",PSACTRL,"IN")) D
- .I $G(DATA)="" Q
- .S PSAINVDT=$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",1)
- .I PSAINVDT<PSAKLDT K ^XTMP("PSAPV",PSACTRL) W "."
- W !,"Finished" K PSACTRL,PSAINVDT,PSAKLDT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPTCH 3523 printed Jan 18, 2025@02:51:32 Page 2
- PSAPTCH ;BHM/DAV - FIND INVOICES PROCESSED BY CONTROLLED SUBS;
- +1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,73**; 10/24/97;Build 3
- +2 ;CS() = array contains item numbers of processed CS invoice
- +3 ;PSACSERR =error flag set
- +4 ;
- +5 DO Q
- +6 ;
- 1 ;Check for uploaded CS invoice
- +1 ;PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
- +2 ;Incoming Order Number
- SET PSAUPORD=$PIECE(PSAIN,"^",4)
- +3 ;Incoming Invoice Number
- SET PSAUPINV=$PIECE(PSAIN,"^",2)
- +4 IF '$DATA(^XTMP("PSAPV",PSACTRL,"IT"))
- KILL ^XTMP("PSAPV",PSACTRL)
- SET PSAINVDL=1
- QUIT
- +5 IF $GET(PSAUPORD)=""
- KILL ^XTMP("PSAPV",PSACTRL)
- SET PSAINVDL=1
- QUIT
- +6 IF $GET(PSAUPINV)=""
- KILL ^XTMP("PSAPV",PSACTRL)
- SET PSAINVDL=1
- QUIT
- +7 IF $LENGTH(PSAIN)'>10
- KILL ^XTMP("PSAPV",PSACTRL)
- SET PSAINVDL=1
- QUIT
- +8 ;Invoice Date
- SET Y=$PIECE(PSAIN,"^",1)
- XECUTE ^DD("DD")
- SET PSAUPDT1=Y
- +9 ;Order Date
- SET Y=$PIECE(PSAIN,"^",3)
- XECUTE ^DD("DD")
- SET PSAUPDT2=Y
- +10 SET INVITM=0
- FOR
- SET INVITM=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",INVITM))
- if INVITM'>0
- QUIT
- SET INV(INVITM)=^XTMP("PSAPV",PSACTRL,"IT",INVITM)
- SET INVCNT=INVITM
- +11 IF '$DATA(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV))
- GOTO Q
- +12 KILL PSAORD,ORDIEN,INVIEN,CSINV
- +13 ;Order # IEN
- SET ORDIEN=$ORDER(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV,0))
- +14 ;Invoice # IEN
- SET INVIEN=$ORDER(^PSD(58.811,"AORD",PSAUPORD,PSAUPINV,ORDIEN,0))
- +15 SET PSDCNT=0
- SET X=0
- FOR
- SET X=$ORDER(^PSD(58.811,ORDIEN,1,INVIEN,1,X))
- if X'>0
- QUIT
- SET PSDCNT=$GET(PSDCNT)+1
- +16 IF INVCNT=PSDCNT
- KILL ^XTMP("PSAPV",PSACTRL)
- QUIT
- +17 WRITE @IOF,!,"** WARNING **",!!,"P.O. Number : ",PSAUPORD,!,"Invoice Number : ",PSAUPINV,!
- +18 ;
- +19 SET PSASTAS=$PIECE($GET(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",3)
- SET PSASTAS=$SELECT(PSASTAS="P":"PROCESSED",PSASTAS="V":"VERIFIED",PSASTAS="C":"COMPLETED",1:"UNKNOWN")
- +20 WRITE !,"Incoming",?40,"Already Marked as "_" * "_PSASTAS_" *",!,"Invoice file",?40,"in Drug Accountability Order file",!
- FOR X=1:1:(IOM-1)
- WRITE "="
- +21 SET Y=$PIECE($GET(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",4)
- XECUTE ^DD("DD")
- WRITE !,PSAUPDT2,?16," <-- Order Date --> ",?40,Y
- +22 SET Y=$PIECE($GET(^PSD(58.811,ORDIEN,1,INVIEN,0)),"^",2)
- XECUTE ^DD("DD")
- WRITE !,PSAUPDT1,?15," <-- Invoice Date --> ",?40,Y
- CHECK WRITE !,?3,$JUSTIFY($GET(INVCNT),8),?16," <-- Line Items -->",?40,$GET(PSDCNT),!!
- +1 ;
- CMPRE READ !,"Do you want to compare item? NO// ",AN:DTIME
- IF AN["^"!(AN="")
- GOTO ASK
- +1 SET AN=$EXTRACT(AN)
- IF "yYnN"'[AN
- WRITE !,"Answer 'Y'es to display the items from the invoice file, as well as the items",!,"already uploaded.",!
- GOTO CMPRE
- +2 IF "nN"[AN
- GOTO ASK
- +3 SET X=0
- FOR
- SET X=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",X))
- if X=""
- QUIT
- SET DATA=$GET(^XTMP("PSAPV",PSACTRL,"IT",X))
- SET PSAITM(X)=DATA
- +4 SET X=0
- FOR
- SET X=$ORDER(^PSD(58.811,ORDIEN,1,INVIEN,1,X))
- if X=""
- QUIT
- SET DATA=$GET(^PSD(58.811,ORDIEN,1,INVIEN,1,X,0))
- SET PSAUPITM(+DATA)=DATA
- +5 if INVCNT'=PSDCNT
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="OK"
- +6 GOTO Q
- +7 ;
- ASK READ !!,"Do you want to delete the incoming invoice ? NO// ",AN:DTIME
- if AN["^"
- GOTO Q
- IF "Nn"[AN
- GOTO Q
- +1 IF "?"[AN
- WRITE !!,"Answer 'Y'es, and the incoming invoice will be deleted.",!
- GOTO ASK
- +2 IF AN=""
- GOTO Q
- +3 IF "Yy"[AN
- KILL ^XTMP("PSAPV",PSACTRL)
- SET PSAINVDL=1
- QUIT
- +4 ;
- +5 ;Kill incoming invoice.
- Q KILL AN,CS,CSCNT,CSIEN,CSINV,DATA,FOUND,INV,INVCNT,INVDEL,INVIEN,INVITM,LINEITM,ORDIEN,PSAORD,PSAUPDT1,PSAUPDT2,PSAUPINV,PSAUPORD,PSDCNT,X,XX,Y
- QUIT
- PSAOLD ;Entry point for deleting old invoices
- +1 IF '$DATA(^XTMP("PSAPV"))
- WRITE !,"Sorry, there aren't any invoices on file."
- GOTO Q
- ASKDT SET %DT="A"
- SET %DT("A")="Delete invoices older than what date: "
- DO ^%DT
- +1 IF Y'<DT
- WRITE !,"Sorry, the date has to be in the past."
- KILL Y
- GOTO ASKDT
- +2 SET PSAKLDT=Y
- +3 ;
- +4 SET PSACTRL=0
- FOR
- SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
- if PSACTRL'>0
- QUIT
- SET DATA=$GET(^XTMP("PSAPV",PSACTRL,"IN"))
- Begin DoDot:1
- +5 IF $GET(DATA)=""
- QUIT
- +6 SET PSAINVDT=$PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",1)
- +7 IF PSAINVDT<PSAKLDT
- KILL ^XTMP("PSAPV",PSACTRL)
- WRITE "."
- End DoDot:1
- +8 WRITE !,"Finished"
- KILL PSACTRL,PSAINVDT,PSAKLDT
- QUIT