APSPLPAT.m

APSPLPAT ;IHS/MSC/PLS - APSP Last Pharmacy Patch Lister ;16-Sep-2013 11:18;DU

 ;;7.0;IHS PHARMACY MODIFICATIONS;**1009,1010,1013,1015,1017**;DEC 11, 2003;Build 40

 ;

EN ;EP

 N ROW,PKG,VER,LP,INFO,EHRREC,AWPDT

 W @IOF,!

 W !,$$CJ^XLFSTR("Pharmacy Related Packages",IOM)

 W !,$$CJ^XLFSTR("Last Patch Lister",IOM),!

 W !,"Package",?34,"Version",?45,"Last Patch",?60,"Date Installed"

 W ! F LP=1:1:IOM W "-"

 W !

 F ROW=0:1 S X=$P($T(PKG+ROW),";;",2) Q:'$L(X)  D

 .S PKG=$P(X,";"),VER=$P(X,";",2),VER=$$VERSION^XPDUTL(PKG)

 .S INFO=$$LAST(PKG,VER)

 .W !,$P(X,";"),?34,VER,?45,$S($P(INFO,U)=-1:"None",1:$P(INFO,U)),?60,$S($P(INFO,U)=-1:$$FMTE^XLFDT($P(INFO,U,3),"5Z"),1:$$FMTE^XLFDT($P(INFO,U,2),"5Z"))

 W !!

 ; Output last EHR install file

 S EHRREC=$$FND()

 I $L(EHRREC) D

 .W !,"The last EHR installation was ",$P(EHRREC,U,2)," on ",$$FMTE^XLFDT($P(EHRREC,U,3),"5Z"),"."

 E  W !,"EHR has not been installed at this site."

 W !

 ; Output last AWP update

 S AWPDT=$G(^APSPCTRL("AWP DATE"))

 I AWPDT D

 .W !,"Last Benchmark Price monthly update occurred on ",$$FMTE^XLFDT(AWPDT,"5Z")

 E  W !,"Benchmark Price has not been installed at this site."

 W !!

 D DIRZ^APSPUTIL()

 Q

 ; Find last EHR installation

FND() ;EP

 N LP,IEN,LSTDT,DAT,DATA,ERR

 D FIND^DIC(9.7,"","@;.01;17I","P","EHR*",,,"","","DATA","ERR")

 S LP=0,IEN=0,LSTDT=0 F  S LP=$O(DATA("DILIST",LP)) Q:'LP  D

 .S DAT=DATA("DILIST",LP,0)

 .I $P(DAT,U,3)>LSTDT D

 ..S IEN=LP

 ..S LSTDT=$P(DAT,U,3)

 Q $S(IEN:DATA("DILIST",IEN,0),1:"")

 ;

LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE

 ;        Patch includes Seq # if Released

 N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN,PKGIDT

 I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1

 S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1

 S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1

 S LATEST=-1,PATCH=-1,SUBIEN=0

 S PKGIDT=$P(^DIC(9.4,PKGIEN,22,VERIEN,0),U,3)

 F  S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0  D

 .;I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST

 .Q:$P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)<LATEST

 .S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)

 Q PATCH_U_LATEST_U_PKGIDT

 ;

PKG ;;NATIONAL DRUG FILE;4.0

 ;;IHS PHARMACY MODIFICATIONS;7.0

 ;;ADVERSE REACTION TRACKING;4.0

 ;;PHARMACY POINT OF SALE;1.0

 ;;AUTOMATED DISPENSING INTERFACE;1.0

 ;;RX OUTPT AUTOMATION INTERFACE;1.0

 ;;BEX AUDIOCARE TELEPHONE REFILL;1.0

 ;;CONTROLLED DRUG EXPORT SYSTEM;1.0

 ;;

 ;;IHS PHARMACY AWP;6.1

 ;;CMOP;2.0

 ;;BAR CODE MED ADMIN;3.0

 ;;CONTROLLED SUBSTANCES;3.0

 ;;DRUG ACCOUNTABILITY;3.0

 ;;PHARMACY BENEFITS MANAGEMENT;4.0

 ;;OUTPATIENT PHARMACY;7.0

 ;;INPATIENT MEDICATIONS;7.0

 ;;PHARMACY DATA MANAGEMENT;1.0

APSPLPAT  ;IHS/MSC/PLS - APSP Last Pharmacy Patch Lister ;16-Sep-2013 11:18;DU

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;**1009,1010,1013,1015,1017**;DEC 11, 2003;Build 40

 +2       ;

EN        ;EP

 +1        NEW ROW,PKG,VER,LP,INFO,EHRREC,AWPDT

 +2        WRITE @IOF,!

 +3        WRITE !,$$CJ^XLFSTR("Pharmacy Related Packages",IOM)

 +4        WRITE !,$$CJ^XLFSTR("Last Patch Lister",IOM),!

 +5        WRITE !,"Package",?34,"Version",?45,"Last Patch",?60,"Date Installed"

 +6        WRITE !

           FOR LP=1:1:IOM

               WRITE "-"

 +7        WRITE !

 +8        FOR ROW=0:1

               SET X=$PIECE($TEXT(PKG+ROW),";;",2)

               IF '$LENGTH(X)

                   QUIT 

               Begin DoDot:1

 +9                SET PKG=$PIECE(X,";")

                   SET VER=$PIECE(X,";",2)

                   SET VER=$$VERSION^XPDUTL(PKG)

 +10               SET INFO=$$LAST(PKG,VER)

 +11               WRITE !,$PIECE(X,";"),?34,VER,?45,$SELECT($PIECE(INFO,U)=-1:"None",1:$PIECE(INFO,U)),?60,$SELECT($PIECE(INFO,U)=-1:$$FMTE^XLFDT($PIECE(INFO,U,3),"5Z"),1:$$FMTE^XLFDT($PIECE(INFO,U,2),"5Z"))

               End DoDot:1

 +12       WRITE !!

 +13      ; Output last EHR install file

 +14       SET EHRREC=$$FND()

 +15       IF $LENGTH(EHRREC)

               Begin DoDot:1

 +16               WRITE !,"The last EHR installation was ",$PIECE(EHRREC,U,2)," on ",$$FMTE^XLFDT($PIECE(EHRREC,U,3),"5Z"),"."

               End DoDot:1

 +17      IF '$TEST

               WRITE !,"EHR has not been installed at this site."

 +18       WRITE !

 +19      ; Output last AWP update

 +20       SET AWPDT=$GET(^APSPCTRL("AWP DATE"))

 +21       IF AWPDT

               Begin DoDot:1

 +22               WRITE !,"Last Benchmark Price monthly update occurred on ",$$FMTE^XLFDT(AWPDT,"5Z")

               End DoDot:1

 +23      IF '$TEST

               WRITE !,"Benchmark Price has not been installed at this site."

 +24       WRITE !!

 +25       DO DIRZ^APSPUTIL()

 +26       QUIT 

 +27      ; Find last EHR installation

FND()     ;EP

 +1        NEW LP,IEN,LSTDT,DAT,DATA,ERR

 +2        DO FIND^DIC(9.7,"","@;.01;17I","P","EHR*",,,"","","DATA","ERR")

 +3        SET LP=0

           SET IEN=0

           SET LSTDT=0

           FOR 

               SET LP=$ORDER(DATA("DILIST",LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +4                SET DAT=DATA("DILIST",LP,0)

 +5                IF $PIECE(DAT,U,3)>LSTDT

                       Begin DoDot:2

 +6                        SET IEN=LP

 +7                        SET LSTDT=$PIECE(DAT,U,3)

                       End DoDot:2

               End DoDot:1

 +8        QUIT $SELECT(IEN:DATA("DILIST",IEN,0),1:"")

 +9       ;

LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE

 +1       ;        Patch includes Seq # if Released

 +2        NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN,PKGIDT

 +3        IF $GET(VER)=""

               SET VER=$$VERSION^XPDUTL(PKG)

               IF 'VER

                   QUIT -1

 +4        SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,""))

           IF 'PKGIEN

               QUIT -1

 +5        SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))

           IF 'VERIEN

               QUIT -1

 +6        SET LATEST=-1

           SET PATCH=-1

           SET SUBIEN=0

 +7        SET PKGIDT=$PIECE(^DIC(9.4,PKGIEN,22,VERIEN,0),U,3)

 +8        FOR 

               SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))

               IF SUBIEN'>0

                   QUIT 

               Begin DoDot:1

 +9       ;I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST

 +10               IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)<LATEST

                       QUIT 

 +11               SET LATEST=$PIECE(^(0),U,2)

                   SET PATCH=$PIECE(^(0),U)

               End DoDot:1

 +12       QUIT PATCH_U_LATEST_U_PKGIDT

 +13      ;

PKG       ;;NATIONAL DRUG FILE;4.0

 +1       ;;IHS PHARMACY MODIFICATIONS;7.0

 +2       ;;ADVERSE REACTION TRACKING;4.0

 +3       ;;PHARMACY POINT OF SALE;1.0

 +4       ;;AUTOMATED DISPENSING INTERFACE;1.0

 +5       ;;RX OUTPT AUTOMATION INTERFACE;1.0

 +6       ;;BEX AUDIOCARE TELEPHONE REFILL;1.0

 +7       ;;CONTROLLED DRUG EXPORT SYSTEM;1.0

 +8       ;;

 +9       ;;IHS PHARMACY AWP;6.1

 +10      ;;CMOP;2.0

 +11      ;;BAR CODE MED ADMIN;3.0

 +12      ;;CONTROLLED SUBSTANCES;3.0

 +13      ;;DRUG ACCOUNTABILITY;3.0

 +14      ;;PHARMACY BENEFITS MANAGEMENT;4.0

 +15      ;;OUTPATIENT PHARMACY;7.0

 +16      ;;INPATIENT MEDICATIONS;7.0

 +17      ;;PHARMACY DATA MANAGEMENT;1.0