PXRMPCPY.m

PXRMPCPY ; SLC/PJH - Copy Patient Lists. ;03/17/2003

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

COPY ;Copy patient list - protocol PXRM PATIENT LIST COPY

 ;

 W IORESET

 ;

 ;Select Patient List to copy

 N DIC,DUOUT,DTOUT,DIROUT,DIRUT,IENN,IENO,PLNAM,ROOT,SIEN,X,Y

 S ROOT="^PXRM(810.4",DIC=ROOT,DIC(0)="AEQ"

 S DIC("A")="Select the Patient List to Copy: "

 ;

 W ! D ^DIC I $D(DUOUT)!$D(DTOUT) Q

 S IENO=$P(Y,U,1) I IENO=-1 Q

 ;

 ;Select list to copy to

 D PLIST^PXRMLCR(.IENN) Q:'IENN

 ;Load list into ^TMP

 D LOAD^PXRMRULE("PXRMPCPY",IENN)

 ;Update new patient list

 D UPDLST^PXRMRULE("PXRMPCPY",IENN,"","")

 ;

 W !!,"Completed copy of '"_ORGNAME_"'"

 W !,"into '"_NAME_"'",! H 2

 Q

PXRMPCPY  ; SLC/PJH - Copy Patient Lists. ;03/17/2003

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

COPY      ;Copy patient list - protocol PXRM PATIENT LIST COPY

 +1       ;

 +2        WRITE IORESET

 +3       ;

 +4       ;Select Patient List to copy

 +5        NEW DIC,DUOUT,DTOUT,DIROUT,DIRUT,IENN,IENO,PLNAM,ROOT,SIEN,X,Y

 +6        SET ROOT="^PXRM(810.4"

           SET DIC=ROOT

           SET DIC(0)="AEQ"

 +7        SET DIC("A")="Select the Patient List to Copy: "

 +8       ;

 +9        WRITE !

           DO ^DIC

           IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

 +10       SET IENO=$PIECE(Y,U,1)

           IF IENO=-1

               QUIT 

 +11      ;

 +12      ;Select list to copy to

 +13       DO PLIST^PXRMLCR(.IENN)

           IF 'IENN

               QUIT 

 +14      ;Load list into ^TMP

 +15       DO LOAD^PXRMRULE("PXRMPCPY",IENN)

 +16      ;Update new patient list

 +17       DO UPDLST^PXRMRULE("PXRMPCPY",IENN,"","")

 +18      ;

 +19       WRITE !!,"Completed copy of '"_ORGNAME_"'"

 +20       WRITE !,"into '"_NAME_"'",!

           HANG 2

 +21       QUIT