PXRMWHPI ; SLC/AGP - Inits for PXRM*2.0*1 ;11/16/2004
 ;;2.0;CLINICAL REMINDERS;**1**;Feb 04, 2005
 ;
 Q
PRE ;
 D DELEI
 D COND
 D REVIEW
 Q
 ;
POST ;
 D INSTALL
 D UPDATE
 Q
 ;
COND ;
 N CFIEN,CFNAME,COND,DA,DIE,DR,NAME,NUM,TIEN,PXRMINST
 S PXRMINST=1
 S CFIEN=$O(^PXRMD(811.4,"B","VA-WH PAP SMEAR IN LAB PKG","")) Q:CFIEN'>0
 S CFNAME=CFIEN_";PXRMD(811.4,"
 F NAME="VA-WH PAP SMEAR SCREEN IN LAB PKG","VA-WH PAP SMEAR UNSATISFACTORY IN LAB/WH PKG" D
 .S TIEN=$O(^PXRMD(811.5,NAME,"")) I TIEN'>0 Q
 .S DA(1)=TIEN
 .I NAME="VA-WH PAP SMEAR UNSATISFACTORY IN LAB/WH PKG" D
 ..S COND="I V(""UNSATISFACTORY"")=""T"""
 .I NAME="VA-WH PAP SMEAR SCREEN IN LAB PKG" D
 ..S COND="I V(""UNSATISFACTORY"")=""F"""
 .S NUM=0 F  S NUM=$O(^PXRMD(811.5,TIEN,20,NUM)) Q:NUM'>0  D  Q
 ..I $G(^PXRMD(811.5,TIEN,20,NUM,0))'[CFNAME Q
 ..S DA=NUM,DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="14///^S X=COND"
 ..D ^DIE
 Q
 ;
DELEI ;If the Exchange File entry already exists delete it.
 ;
 N IND,LIST,LUVALUE,NUM
 ;
 ;
 S LUVALUE(1)="VA-WH MAMMOGRAM REVIEW RESULTS"
 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
 S NUM=$P(LIST("DILIST",0),U,1)
 I NUM'=0 D
 .F IND=1:1:NUM D
 .. N DA,DIK
 .. S DIK="^PXD(811.8,"
 .. S DA=LIST("DILIST",2,IND)
 .. D ^DIK
 ;
 S LUVALUE(1)="VA-WH MAMMOGRAM SCREENING"
 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
 S NUM=$P(LIST("DILIST",0),U,1)
 I NUM'=0 D
 .F IND=1:1:NUM D
 .. N DA,DIK
 .. S DIK="^PXD(811.8,"
 .. S DA=LIST("DILIST",2,IND)
 .. D ^DIK
 ;
 S LUVALUE(1)="VA-WH PAP SMEAR REVIEW RESULTS"
 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
 S NUM=$P(LIST("DILIST",0),U,1)
 I NUM'=0 D
 .F IND=1:1:NUM D
 .. N DA,DIK
 .. S DIK="^PXD(811.8,"
 .. S DA=LIST("DILIST",2,IND)
 .. D ^DIK
 ;
 S LUVALUE(1)="VA-WH PAP SMEAR SCREENING"
 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
 S NUM=$P(LIST("DILIST",0),U,1)
 I NUM'=0 D
 .F IND=1:1:NUM D
 .. N DA,DIK
 .. S DIK="^PXD(811.8,"
 .. S DA=LIST("DILIST",2,IND)
 .. D ^DIK
 Q
 ;
REVIEW ;
 N TIEN,CFIEN,CFNAME,DA,DIE,DR,NAME,NNAME,NEW,PXRMINST
 S PXRMINST=1
 S DIE="^PXRMD(811.5,",NEW=1
 F NAME="VA-WH MAMMOGRAM PENDING REVIEW ","VA-WH PAP SMEAR PENDING REVIEW" D
 .S TIEN=$O(^PXRMD(811.5,"B",NAME,"")) Q:TIEN'>0
 .I NAME["MAMMOGRAM" D
 ..S NNAME="VA-WH MAMMOGRAM PENDING REVIEW",DA=TIEN
 ..S DR=".01///^S X=NNAME" D ^DIE
 ..S DA(1)=DA
 ..S CFIEN=$O(^PXRMD(811.4,"B","VA-WH MAMMOGRAM IN WH PKG","")) Q:CFIEN'>0
 ..S CFNAME=CFIEN_";PXRMD(811.4,"
 ..S DA=$O(^PXRMD(811.5,DA(1),20,"B",CFNAME,"")) Q:DA'>0
 ..S DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="15///^S X=NEW"
 ..D ^DIE
 .I NAME["PAP" D
 ..S DA(1)=TIEN
 ..S CFIEN=$O(^PXRMD(811.4,"B","VA-WH PAP SMEAR IN WH PKG","")) Q:CFIEN'>0
 ..S CFNAME=CFIEN_";PXRMD(811.4,"
 ..S DA=$O(^PXRMD(811.5,DA(1),20,"B",CFNAME,"")) Q:DA'>0
 ..S DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="15///^S X=NEW"
 ..D ^DIE
 Q
 ;
INSTALL ;Silent mode install.
 N IEN,LUVALUE
 ;
 S PXRMINST=1
 ;
 S LUVALUE(1)="VA-WH MAMMOGRAM REVIEW RESULTS"
 S LUVALUE(2)="02/04/2005@17:11:10"
 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 I IEN'=0 D
 . N TEXT
 . S TEXT="Installing reminder "_LUVALUE(1)
 . D BMES^XPDUTL(TEXT)
 . D INSTALL^PXRMEXSI(IEN)
 ;
 ;
 S LUVALUE(1)="VA-WH MAMMOGRAM SCREENING"
 S LUVALUE(2)="02/04/2005@17:11:35"
 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 I IEN'=0 D
 . N TEXT
 . S TEXT="Installing reminder "_LUVALUE(1)
 . D BMES^XPDUTL(TEXT)
 . D INSTALL^PXRMEXSI(IEN)
 ;
 ;
 S LUVALUE(1)="VA-WH PAP SMEAR REVIEW RESULTS"
 S LUVALUE(2)="02/04/2005@17:12:10"
 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 I IEN'=0 D
 . N TEXT
 . S TEXT="Installing reminder "_LUVALUE(1)
 . D BMES^XPDUTL(TEXT)
 . D INSTALL^PXRMEXSI(IEN)
 ;
 S LUVALUE(1)="VA-WH PAP SMEAR SCREENING"
 S LUVALUE(2)="02/04/2005@17:12:52"
 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 I IEN'=0 D
 . N TEXT
 . S TEXT="Installing reminder "_LUVALUE(1)
 . D BMES^XPDUTL(TEXT)
 . D INSTALL^PXRMEXSI(IEN)
 Q
 ;
UPDATE ;
 N DA,DIE,DR,WHIEN,PIEN,PNAME
 S WHIEN=$O(^PXRMD(801.45,"B","WH","")) Q:WHIEN'>0
 F PNAME="PXRM WH UPDATE TREATMENT NEED","PXRM WH NOTIFICATION TYPE" D
 .S DIE="^PXRMD(801.41,",DR="14////^S X=WHIEN"
 .S DA=$O(^PXRMD(801.41,"B",PNAME,"")) Q:DA'>0
 .D ^DIE
 .W !,"UPDATING FORCE VALUE: "_PNAME
 Q