BCH10P6.m

BCH10P6 ;IHS/CMI/LAB - IHS CHR patch 6 [ 09/18/98  1:29 PM ]

 ;;1.0;IHS RPMS CHR SYSTEM;**6**;OCT 28, 1996

 ;

 ;go through all chr records, if any service is HE or CF

 ;find V POV and change code accordingly

START ;start processing patch 6

 S ZTQUEUED="" ;to prevent other routine from talking

 S (BCHRIEN,BCHCNT)=0 F  S BCHRIEN=$O(^BCHR(BCHRIEN)) Q:BCHRIEN'=+BCHRIEN  D

 .Q:'$P(^BCHR(BCHRIEN,0),U,15)  ;no pcc visit created

 .S (BCHP,BCHGOT)=0 F  S BCHP=$O(^BCHRPROB("AD",BCHRIEN,BCHP)) Q:BCHP'=+BCHP  D

 ..Q:'$D(^BCHRPROB(BCHP))

 ..Q:$P(^BCHRPROB(BCHP,0),U,4)=""

 ..S X=$P(^BCHRPROB(BCHP,0),U,4),X=$P(^BCHTSERV(X,0),U,3)

 ..Q:'(X="HE"!(X="CF"))

 ..S BCHGOT=1

 ..Q

 .Q:'BCHGOT

 .W " ",BCHRIEN

 .S BCHCNT=BCHCNT+1

 .S BCHR=BCHRIEN

 .S BCHEV("TYPE")="E"

 .S BCHEV("VFILES",9000010)=$P(^BCHR(BCHR,0),U,15)

 .S X=0 F  S X=$O(^BCHR(BCHR,31,X)) Q:X'=+X  S F=$P(^BCHR(BCHR,31,X,0),U),N=$P(^(0),U,2) I F,N S BCHEV("VFILES",F,N)=""

 .K ^BCHR(BCHR,31)

 .D PROTOCOL^BCHUADD1

 .Q

 W !!,"All done updating. ",BCHCNT," CHR Records updated.",!

 D EN^XBVK("BCH")

 K ZTQUEUED

 Q

BCH10P6   ;IHS/CMI/LAB - IHS CHR patch 6 [ 09/18/98  1:29 PM ]

 +1       ;;1.0;IHS RPMS CHR SYSTEM;**6**;OCT 28, 1996

 +2       ;

 +3       ;go through all chr records, if any service is HE or CF

 +4       ;find V POV and change code accordingly

START     ;start processing patch 6

 +1       ;to prevent other routine from talking

           SET ZTQUEUED=""

 +2        SET (BCHRIEN,BCHCNT)=0

           FOR 

               SET BCHRIEN=$ORDER(^BCHR(BCHRIEN))

               IF BCHRIEN'=+BCHRIEN

                   QUIT 

               Begin DoDot:1

 +3       ;no pcc visit created

                   IF '$PIECE(^BCHR(BCHRIEN,0),U,15)

                       QUIT 

 +4                SET (BCHP,BCHGOT)=0

                   FOR 

                       SET BCHP=$ORDER(^BCHRPROB("AD",BCHRIEN,BCHP))

                       IF BCHP'=+BCHP

                           QUIT 

                       Begin DoDot:2

 +5                        IF '$DATA(^BCHRPROB(BCHP))

                               QUIT 

 +6                        IF $PIECE(^BCHRPROB(BCHP,0),U,4)=""

                               QUIT 

 +7                        SET X=$PIECE(^BCHRPROB(BCHP,0),U,4)

                           SET X=$PIECE(^BCHTSERV(X,0),U,3)

 +8                        IF '(X="HE"!(X="CF"))

                               QUIT 

 +9                        SET BCHGOT=1

 +10                       QUIT 

                       End DoDot:2

 +11               IF 'BCHGOT

                       QUIT 

 +12               WRITE " ",BCHRIEN

 +13               SET BCHCNT=BCHCNT+1

 +14               SET BCHR=BCHRIEN

 +15               SET BCHEV("TYPE")="E"

 +16               SET BCHEV("VFILES",9000010)=$PIECE(^BCHR(BCHR,0),U,15)

 +17               SET X=0

                   FOR 

                       SET X=$ORDER(^BCHR(BCHR,31,X))

                       IF X'=+X

                           QUIT 

                       SET F=$PIECE(^BCHR(BCHR,31,X,0),U)

                       SET N=$PIECE(^(0),U,2)

                       IF F

                           IF N

                               SET BCHEV("VFILES",F,N)=""

 +18               KILL ^BCHR(BCHR,31)

 +19               DO PROTOCOL^BCHUADD1

 +20               QUIT 

               End DoDot:1

 +21       WRITE !!,"All done updating. ",BCHCNT," CHR Records updated.",!

 +22       DO EN^XBVK("BCH")

 +23       KILL ZTQUEUED

 +24       QUIT